pracma/0000755000176200001440000000000014153577552011533 5ustar liggesuserspracma/NAMESPACE0000644000176200001440000000042113400317701012725 0ustar liggesusers### ### NAMESPACE ### ## Public routines exportPattern("^[[:alpha:]]+") ## Imports # importFrom("quadprog", "solve.QP") # importFrom("NlcOptim", "solnl") # import("datasets") import("graphics") import("grDevices") import("stats") import("utils") ## S3 and S4 Methods pracma/demo/0000755000176200001440000000000014153356033012444 5ustar liggesuserspracma/demo/pracma.R0000644000176200001440000000044011645776642014047 0ustar liggesusers## ## p r a c m a . R 'pracma' Demos ## require("pracma") # Remember graphics settings opar <- par(ask = dev.interactive(orNone = TRUE)) if (interactive()) readline("Press ENTER to continue: ") cat("Some demos will follow shortly. BYE.\n") # Reset graphics parameters par(opar) pracma/demo/00Index0000644000176200001440000000005611645776642013616 0ustar liggesuserspracma Some demos for the pracma package pracma/README.md0000644000176200001440000001731714024777552013022 0ustar liggesusers# Package PRACMA ## Introduction This package provides R implementations of more advanced functions in numerical analysis, with a special view on on optimization and time series routines. Uses Matlab/Octave function names where appropriate to simplify porting. Some of these implementations are the result of courses on Scientific Computing (``Wissenschaftliches Rechnen'') and are mostly intended to demonstrate how to implement certain algorithms in R/S. Others are implementations of algorithms found in textbooks. ## Details The package encompasses functions from all areas of numerical analysis, for example: * Root finding and minimization of univariate functions, e.g. Newton-Raphson, Brent-Dekker, Fibonacci or `golden ratio' search. * Handling polynomials, including roots and polynomial fitting, e.g. Laguerre's and Muller's methods. * Interpolation and function approximation, barycentric Lagrange interpolation, Pade and rational interpolation, Chebyshev or trigonometric approximation. * Some special functions, e.g. Fresnel integrals, Riemann's Zeta or the complex Gamma function, and Lambert's W computed iteratively through Newton's method. * Special matrices, e.g. Hankel, Rosser, Wilkinson * Numerical differentiation and integration, Richardson approach and ``complex step'' derivatives, adaptive Simpson and Lobatto integration and adaptive Gauss-Kronrod quadrature. * Solvers for ordinary differential equations and systems, Euler-Heun, classical Runge-Kutta, ode23, or predictor-corrector method such as the Adams-Bashford-Moulton. * Some functions from number theory, such as primes and prime factorization, extended Euclidean algorithm. * Sorting routines, e.g. recursive quickstep. * Several functions for string manipulation and regular search, all wrapped and named similar to their Matlab analogues. ## Goals It serves three main goals: * Collecting R scripts that can be demonstrated in courses on Numerical Analysis or Scientific Computing using R/S as the chosen programming language. * Wrapping functions with appropriate Matlab names to simplify porting programs from Matlab or Octave to R. * Providing an environment in which R can be used as a full-blown numerical computing system. Besides that, many of these functions could be called in R applications as they do not have comparable counterparts in other R packages (at least at this moment, as far as I know). All referenced books have been utilized in one way or another. Web links have been provided where reasonable. ## Emulated MATLAB Functions The following 220 functions are emulations of correspondingly named Matlab functions and bear the same signature as their Matlab cousins if possible: accumarray, acosd, acot, acotd, acoth, acsc, acscd, acsch, and, angle, ans, arrayfun, asec, asecd, asech, asind, atand, atan2d, beep, bernoulli, blank, blkdiag, bsxfun, cart2pol, cart2sph, cd, ceil, circshift, clear, compan, cond, conv, cosd, cot, cotd, coth, cross, csc, cscd, csch, cumtrapz, dblquad, deblank, deconv, deg2rad, detrend, deval, disp, dot, eig, eigint, ellipj, ellipke, eps, erf, erfc, erfcinv, erfcx, erfi, erfinv, errorbar, expint, expm, eye, ezcontour, ezmesh, ezplot, ezpolar, ezsurf, fact, fftshift, figure, findpeaks, findstr, flipdim, fliplr, flipud, fminbnd, fmincon, fminsearch, fminunc, fplot, fprintf, fsolve, fzero, gammainc, gcd, geomean, gmres, gradient, hadamard, hankel, harmmean, hilb, histc, humps, hypot, idivide, ifft, ifftshift, inpolygon, integral, integral2, integral3, interp1, interp2, inv, isempty, isprime, kron, legendre, linprog, linspace, loglog, logm, logseq, logspace, lsqcurvefit, lsqlin, lsqnonlin, lsqnonneg, lu, magic, meshgrid, mkpp, mldivide, mod, mrdivide, nchoosek, ndims, nextpow2, nnz, normest, nthroot, null, num2str, numel, ode23, ode23s, ones, or, orth, pascal, pchip, pdist, pdist2, peaks, perms, piecewise, pinv, plotyy, pol2cart, polar, polyfit, polyint, polylog, polyval, pow2, ppval, primes, psi, pwd, quad, quad2d, quadgk, quadl, quadprog, quadv, quiver, rad2deg, randi, randn, randsample, rat, rats, regexp, regexpi, regexpreg, rem, repmat, roots, rosser, rot90, rref, runge, sec, secd, sech, semilogx, semilogy, sinc, sind, size, sortrows, sph2cart, sqrtm, squareform, std, str2num, strcat, strcmp, strcmpi, strfind, strfindi, strjust, subspace, tand, tic, toc, trapz, tril, trimmean, triplequad, triu, vander, vectorfield, ver, what, who, whos, wilkinson, zeros, zeta The following Matlab function names have been capitalized in `pracma' to avoid shadowing functions from R base or one of its recommended packages (on request of Bill Venables and because of Brian Ripley's CRAN policies): Diag, factors, finds, Fix, Imag, Lcm, Mode, Norm, nullspace (<- null), Poly, Rank, Real, Reshape, strRep, strTrim, Toeplitz, Trace, uniq (<- unique). To use `ans` instead of `ans()` -- as is common practice in Matlab -- type (and similar for other Matlab commands): makeActiveBinding("ans", function() .Last.value, .GlobalEnv) makeActiveBinding("who", who(), .GlobalEnv) ### Note The R package `matlab' contains some of the basic routines from Matlab, but unfortunately not any of the higher math routines. ## References Abramowitz, M., and I. A. Stegun (1972). Handbook of Mathematical Functions (with Formulas, Graphs, and Mathematical Tables). Dover, New York. URL: www.math.ubc.ca/~cbm/aands/notes.htm Arndt, J. (2010). Matters Computational: Ideas, Algorithms, Source Code. Springer-Verlag, Berlin Heidelberg Dordrecht. FXT: a library of algorithms: . Cormen, Th. H., Ch. E. Leiserson, and R. L. Rivest (2009). Introduction to Algorithms. Third Edition, The MIT Press, Cambridge, MA. Encyclopedia of Mathematics (2012). Editor-in-Chief: Ulf Rehmann. . Gautschi, W. (1997). Numerical Analysis: An Introduction. Birkhaeuser, Boston. Gentle, J. E. (2009). Computational Statistics. Springer Science+Business Media LCC, New York. Hazewinkel, M., Editor (2002). Encyclopaedia of Mathematics. Springer-Verlag, Berlin Heidelberg New York. MathWorld.com (2011). Wolfram MathWorld: . Matlab Central: . NIST: National Institute of Standards and Technology. Olver, F. W. J., et al. (2010). NIST Handbook of Mathematical Functions. Cambridge University Press. Internet: NIST Digital Library of Mathematical Functions, ; Dictionary of Algorithms and Data Structures, ; Guide to Available Mathematical Software, Press, W. H., S. A. Teukolsky, W. T Vetterling, and B. P. Flannery (2007). Numerical Recipes: The Art of Numerical Computing. Third Edition, incl. Numerical Recipes Software, Cambridge University Press, New York. URL: numerical.recipes/book/book.html Quarteroni, A., R. Sacco, and F. Saleri (2007). Numerical Mathematics. Second Edition, Springer-Verlag, Berlin Heidelberg. Skiena, St. S. (2008). The Algorithm Design Manual. Second Edition, Springer-Verlag, London. The Stony Brook Algorithm Repository: . Stoer, J., and R. Bulirsch (2002). Introduction to Numerical Analysis. Third Edition, Springer-Verlag, New York. Strang, G. (2007). Computational Science and Engineering. Wellesley-Cambridge Press. Weisstein, E. W. (2003). CRC Concise Encyclopedia of Mathematics. Second Edition, Chapman & Hall/CRC Press. Zhang, S., and J. Jin (1996). Computation of Special Functions. John Wiley & Sons. pracma/data/0000755000176200001440000000000014153356033012431 5ustar liggesuserspracma/data/brown72.rda0000644000176200001440000001515414153356130014425 0ustar liggesusersEw\Oǣث$df˪^~g-P*3dHQ.)Q+RY!!|Oޝsk:c^ tttUS]WS EKҁ&ͱ]ƕz-}oNXLx~*`=wNm+X~CgkyԄ@8Uny#-%ֲdn^? ;a^i~gKd_(,a݄nm^Z]Ds| !:/_ .׵C`Snx0])zBoҏpHܴ}ߐ>u+ HFO!MNn61Db u' :o!.kn;CvYFW@v:4}Cha< m`#'ZvzsϋI+!tK[du\}Ǎ`@q:Da5@Ҭ ͺȩj?}v5S0dHW =qx-4DAUw1/Ҭi{Ο3˛ b }po9\)=OSZks{V{U9k\-7,h1DҀ@^;bhծD'&CٮH1®sasǦִ/S\ Z0*}cpuA~dOӇߛw/r$};eIHn =U]z b:3bMB:qhRW}M3rfէDtG.aG[j1W 3(.~ȁuL[zp&VD$çx1io;6OPI}usvFBxqGCSp-b^n6 h)W` t] l@s`w=VP~oZ3cK{6h@M;?(4-I{xǦBëG}RWDr:)1U皎 1m}ڸsN!׎ytێ ¦v ſԭ/C5E5:Lfp 9ŵ.Ed G;'ȇ>O%g_x~Y3Qf=0 loL[p#ېh?~jo={g@l_=/ji="^'9Í.%-F=|aU=cV]_NF_3}F| ?{M%!GvykRjD:Ҽ4r2+{p tm*opOLCZ5}DWY4GP?{!=lA)Ʒg(rL:6kãK!{ppKBSΆ??f M-׬ YOҡCu!NrKuqH)lh1%=@Bux{$93y|ڒ5n(xo /9d6ݩ/fY rZ'ː~>*Q; fwu/xOS/('}OƁ#b~eRͩQfj9GBD I~_bbnGK M_X,RڲmMͰ w*,ѻ@|mp5O|9nF\@Vt7՗2} .%8 sgoSwBqzjN{  6NSXR.`ǜ{L{u)]w)rVlSAێ|P=l 27)_w0kzR~:M3 >UwNep1TA?|b8C/rn} i[t/ڰ]9*չЄ/OoBqΦ'ZSxlqg^+?L?5 nn7P9E3k#>o>oG:|WWvXAnԏ=oC[$Z۫σpQ䢢7[|&m_2x:4%#vA;@M.%Ќ.CH5NW =Z?*uͭwin(.xEӖ#@^DsDUNNVpDV!V}&2#?Uq5\rP 'F?{3IHK@)6|nD=poI+R}Ŝ [>Ҩ^zMXY-Iq5V|Ъ+Խޙ_ p@1b~ kw00[%|_rE:/r*ap&?f 9jSzn2:w ʉ[aL*O2~)rݿסfh;=-Vה׺\? (aQ QX"0WzBt{z0ϛ_Oi|P ;f=\V/#I5ƈ:a6:WI&'@nK/T@)g >ҳ勆Ou|΃иTh<=U]gMx\My5u}0)j wP3tϱeC O\jW٦_Bޤ1ꬶ&r|^3ĽvΓ  >7-Eg=5;|ӝ hҕK_/&.e>ϋ&{%QN ;W;8*fRWFX;XF0*dע] OtxcNsUhQ{fhe"Cl d_DžçG{U,{ܕY}^z-O*k;]RF14'~3i}՜ۨu5ԹW\ȃ4^eKɗVːg0=rok= lR: %T'}*xA>yXn۪N1 t?N(kRhCԬD:wb.U-|n<=d|ܨ~ӼB*G{狷BPuؗٴ! ? e4m&dMuWy';.F|Y Ҡ`Ln_Gh^D() R8/Pu4nhoѐt0~r2fS)އ Go.χO^wc CMJT# ޝ;r[G X?SC>u5U"ebB̓WW과]'X6OaXbhn+e r4?# <:K3YӳjS?"h3q7ZCBX嘂ʄ3U-z>pMQi1wS#^`d/ mExM{e{!- ӧnY~>H <@:J @搰Q8)iU K⇋ g"VE Pv|ˌ-NJ([2ȥr_5d@Ґ ${ sWBS9TTWv:@]c^ߒzP|*_Uy67Ɣ|wɗvpFsGgoxT擗agdy!}xMe6:?Z$fڏH݋5nfFJAS1Fށa |\v*H4sb'?Ⲏ~F^rfW;ZT\U'<%.^?h\iiTjk|O )*]$L>DG镚'6A1`_IvlZV;i+%xKCؠ0WRI?5P9';֖V~i/B_ve'#.mE(9t]4wo5i ٷ!5vMYmꃓ#;O"Fѥ?|HZ҂sQU ?X>=S5![_ * ˷iMwyUKY`A 7]X0t<;pٚ7;rn[ ,*<Kovq(9aI.V9ݬ`zU -SqE{vh ϟ~ De^ Eg=_`CZl{~`R&>Uڳ߱'f?=#ϥCď V?Ҙ-oѹuHW0#e QLjc#+M@G4$n[;H96)I {!=." RWS+ώ~ڊ\ܦS`6dZx^yNrȮ`qAcWjx]u+OV}qu-Ւ[q戟!<.7QOV5nw_)Fh)s uwqHg#hFyA9ʣݡu,v;̆\C=򫰯fD#auO-izP?^qnQ?wW{P:mjUoVLbPIW6q]ʢR,ٷ5rnAn~f=wwϜ{x%V .q?ՉV;X+`TwZ>Dc~*q8mmoyݳ" WRu.s(첸\^eTސKB{XAƷ*U16XYoPSu #]N sVvw]QP TWMG@Ztq响qĉ#6_fS\)cJJ Oq|xv[ЅO*ߐ:꞊ b>Q'O:VsFXOTR&YTUm?~3ʮgz]}]Vufk"Udd/#o1_}?FD%ޡJ>+6rsʈ~|&zmGGk ʫN!r *>E~Ohe姎k9@},Z-;9_*gj(Z?T+'"]h(B1iv!utt*l46 pracma/data/titanium.rda0000644000176200001440000000111114153356130014743 0ustar liggesusers r0b```b`adb`b2Y# '(,I,e``c`bC B7[@(}Bh@ (}BJ@ (Bq@(JPj;P;wB j.PwCj^P{Ajp'@'@(]@3 P'>~n積O~VhX]}mP82{5j/+ퟲe 7啕"N Sm@]q5n cz['g@ѷ3ŁvnalH =YQ2@;0Y?'f}v3XqSdퟃ(5O?Hqu"U?A,`M90` |>@?y@8+`J4Ez0- - @,ΣX 3&ȕXVa?pracma/man/0000755000176200001440000000000014153356040012271 5ustar liggesuserspracma/man/softline.Rd0000644000176200001440000000337612042212424014404 0ustar liggesusers\name{softline} \alias{softline} \title{ Soft (Inexact) Line Search } \description{ Fletcher's inexact line search algorithm. } \usage{ softline(x0, d0, f, g = NULL) } \arguments{ \item{x0}{initial point for linesearch.} \item{d0}{search direction from \code{x0}.} \item{f}{real function of several variables that is to be minimized.} \item{g}{gradient of objective function \code{f}; computed numerically if not provided.} } \details{ Many optimization methods have been found to be quite tolerant to line search imprecision, therefore inexact line searches are often used in these methods. } \value{ Returns the suggested inexact optimization paramater as a real number \code{a0} such that \code{x0+a0*d0} should be a reasonable approximation. } \note{ Matlab version of an inexact linesearch algorithm by A. Antoniou and W.-S. Lu in their textbook ``Practical Optimization''. Translated to R by Hans W Borchers. } \references{ Fletcher, R. (1980). Practical Methods of Optimization, Volume 1., Section 2.6. Wiley, New York. Antoniou, A., and W.-S. Lu (2007). Practical Optimization: Algorithms and Engineering Applications. Springer Science+Business Media, New York. } \seealso{ \code{\link{gaussNewton}} } \examples{ ## Himmelblau function f_himm <- function(x) (x[1]^2 + x[2] - 11)^2 + (x[1] + x[2]^2 - 7)^2 g_himm <- function(x) { w1 <- (x[1]^2 + x[2] - 11); w2 <- (x[1] + x[2]^2 - 7) g1 <- 4*w1*x[1] + 2*w2; g2 <- 2*w1 + 4*w2*x[2] c(g1, g2) } # Find inexact minimum from [6, 6] in the direction [-1, -1] ! softline(c(6, 6), c(-1, -1), f_himm, g_himm) # [1] 3.458463 # Find the same minimum by using the numerical gradient softline(c(6, 6), c(-1, -1), f_himm) # [1] 3.458463 } \keyword{ optimize } pracma/man/segm_intersect.Rd0000644000176200001440000000266611652316301015602 0ustar liggesusers\name{segm_intersect} \alias{segm_intersect} \title{ Segment Intersection } \description{ Do two segments have at least one point in common? } \usage{ segm_intersect(s1, s2) } \arguments{ \item{s1, s2}{Two segments, represented by their end points; i.e., \code{s <- rbind(p1, p2)} when \code{p1, p2} are the end points.} } \details{ First compares the `bounding boxes', and if those intersect looks at whether the other end points lie on different sides of each segment. } \value{ Logical, \code{TRUE} if these segments intersect. } \references{ Cormen, Th. H., Ch. E. Leiserson, and R. L. Rivest (2009). Introduction to Algorithms. Third Edition, The MIT Press, Cambridge, MA. } \note{ Should be written without reference to the \code{cross} function. Should also return the intersection point, see the example. } \seealso{ \code{\link{segm_distance}} } \examples{ \dontrun{ plot(c(0, 1), c(0, 1), type="n", xlab = "", ylab = "", main = "Segment Intersection") grid() for (i in 1:20) { s1 <- matrix(runif(4), 2, 2) s2 <- matrix(runif(4), 2, 2) if (segm_intersect(s1, s2)) { clr <- "red" p1 <- s1[1, ]; p2 <- s1[2, ]; p3 <- s2[1, ]; p4 <- s2[2, ] A <- cbind(p2 - p1, p4 - p3) b <- (p3 - p1) a <- solve(A, b) points((p1 + a[1]*(p2-p1))[1], (p1 + a[1]*(p2-p1))[2], pch = 19, col = "blue") } else clr <- "darkred" lines(s1[,1], s1[, 2], col = clr) lines(s2[,1], s2[, 2], col = clr) }} } \keyword{ geom } pracma/man/muller.Rd0000644000176200001440000000332512246147543014072 0ustar liggesusers\name{muller} \alias{muller} \title{ Muller's Method } \description{ Muller's root finding method, similar to the secant method, using a parabola through three points for approximating the curve. } \usage{ muller(f, p0, p1, p2 = NULL, maxiter = 100, tol = 1e-10) } \arguments{ \item{f}{function whose root is to be found; function needs to be defined on the complex plain.} \item{p0, p1, p2}{three starting points, should enclose the assumed root.} \item{tol}{relative tolerance, change in successive iterates.} \item{maxiter}{maximum number of iterations.} } \details{ Generalizes the secant method by using parabolic interpolation between three points. This technique can be used for any root-finding problem, but is particularly useful for approximating the roots of polynomials, and for finding zeros of analytic functions in the complex plane. } \value{ List of \code{root}, \code{fval}, \code{niter}, and \code{reltol}. } \note{ Muller's method is considered to be (a bit) more robust than Newton's. } \references{ Pseudo- and C code available from the `Numerical Recipes'; pseudocode in the book `Numerical Analysis' by Burden and Faires (2011). } \seealso{ \code{\link{secant}}, \code{\link{newtonRaphson}}, \code{\link{newtonsys}} } \examples{ muller(function(x) x^10 - 0.5, 0, 1) # root: 0.9330329915368074 f <- function(x) x^4 - 3*x^3 + x^2 + x + 1 p0 <- 0.5; p1 <- -0.5; p2 <- 0.0 muller(f, p0, p1, p2) ## $root ## [1] -0.3390928-0.4466301i ## ... ## Roots of complex functions: fz <- function(z) sin(z)^2 + sqrt(z) - log(z) muller(fz, 1, 1i, 1+1i) ## $root ## [1] 0.2555197+0.8948303i ## $fval ## [1] -4.440892e-16+0i ## $niter ## [1] 8 ## $reltol ## [1] 3.656219e-13 } \keyword{ math } pracma/man/gradient.Rd0000644000176200001440000000375211572466165014400 0ustar liggesusers\name{gradient} \alias{gradient} \title{ Discrete Gradient (Matlab Style) } \description{ Discrete numerical gradient. } \usage{ gradient(F, h1 = 1, h2 = 1) } \arguments{ \item{F}{vector of function values, or a matrix of values of a function of two variables.} \item{h1}{x-coordinates of grid points, or one value for the difference between grid points in x-direction.} \item{h2}{y-coordinates of grid points, or one value for the difference between grid points in y-direction.} } \details{ Returns the numerical gradient of a vector or matrix as a vector or matrix of discrete slopes in x- (i.e., the differences in horizontal direction) and slopes in y-direction (the differences in vertical direction). A single spacing value, \code{h}, specifies the spacing between points in every direction, where the points are assumed equally spaced. } \value{ If \code{F} is a vector, one gradient vector will be returned. If \code{F} is a matrix, a list with two components will be returned: \item{X}{numerical gradient/slope in x-direction.} \item{Y}{numerical gradient/slope in x-direction.} where each matrix is of the same size as \code{F}. } \note{ TODO: If \code{h2} is missing, it will not automatically be adapted. } \seealso{ \code{\link{fderiv}} } \examples{ x <- seq(0, 1, by=0.2) y <- c(1, 2, 3) (M <- meshgrid(x, y)) gradient(M$X^2 + M$Y^2) gradient(M$X^2 + M$Y^2, x, y) \dontrun{ # One-dimensional example x <- seq(0, 2*pi, length.out = 100) y <- sin(x) f <- gradient(y, x) max(f - cos(x)) #=> 0.00067086 plot(x, y, type = "l", col = "blue") lines(x, cos(x), col = "gray", lwd = 3) lines(x, f, col = "red") grid() # Two-dimensional example v <- seq(-2, 2, by=0.2) X <- meshgrid(v, v)$X Y <- meshgrid(v, v)$Y Z <- X * exp(-X^2 - Y^2) image(v, v, t(Z)) contour(v, v, t(Z), col="black", add = TRUE) grid(col="white") grX <- gradient(Z, v, v)$X grY <- gradient(Z, v, v)$Y quiver(X, Y, grX, grY, scale = 0.2, col="blue") } } \keyword{ math } pracma/man/polytrans.Rd0000644000176200001440000000246713471575664014645 0ustar liggesusers\name{polytrans, polygcf} \alias{polytrans} \alias{polygcf} \title{Polynomial Transformations} \description{ Transform a polynomial, find a greatest common factor, or determine the multiplicity of a root. } \usage{ polytrans(p, q) polygcf(p, q, tol = 1e-12) } \arguments{ \item{p, q}{vectors representing two polynomials.} \item{tol}{tolerance for coefficients to tolerate.} } \details{ Transforms polynomial \code{p} replacing occurences of \code{x} with another polynomial \code{q} in \code{x}. Finds a greatest common divisor (or factor) of two polynomials. Determines the multiplicity of a possible root; returns 0 if not a root. This is in general only true to a certain tolerance. } \value{ \code{polytrans} and \code{polygcf} return vectors representing polynomials. \code{rootsmult} returns a natural number (or 0). } \note{ There are no such functions in Matlab or Octave. } \seealso{ \code{\link{polyval}} } \examples{ # (x+1)^2 + (x+1) + 1 polytrans(c(1, 1, 1), c(1, 1)) #=> 1 3 3 polytrans(c(1, 1, 1), c(-1, -1)) #=> 1 1 1 p <- c(1,-1,1,-1,1) #=> x^4 - x^3 + x^2 - x + 1 q <- c(1,1,1) #=> x^2 + x + 1 polygcf(polymul(p, q), q) #=> [1] 1 1 1 p = polypow(c(1, -1), 6) #=> [1] 1 -6 15 -20 15 -6 1 rootsmult(p, 1) #=> [1] 6 } \keyword{ math } pracma/man/andrews.Rd0000644000176200001440000000340212042212424014212 0ustar liggesusers\name{andrewsplot} \alias{andrewsplot} \title{ Andrews' Curves } \description{ Plots Andrews' curves in cartesian or polar coordinates. } \usage{ andrewsplot(A, f, style = "pol", scaled = FALSE, npts = 101) } \arguments{ \item{A}{numeric matrix with at least two columns.} \item{f}{factor or integer vector with \code{nrow(A)} elements.} \item{style}{character variable, only possible values `cart' or `pol'.} \item{scaled}{logical; if true scales each column to have mean 0 and standard deviation 1 (not yet implemented).} \item{npts}{number of points to plot.} } \details{ \code{andrewsplot} creates an Andrews plot of the multivariate data in the matrix \code{A}, assigning different colors according to the factor or integer vector \code{f}. Andrews' plot represent each observation (row) by a periodic function over the interval \code{[0, 2*pi]}. This function for the \code{i}-th observation is defined as ... The plot can be seen in cartesian or polar coordinates --- the latter seems appropriate as all these functions are periodic. } \value{ Generates a plot, no return value. } \note{ Please note that a different ordering of the columns will result in quite different functions and overall picture. There are variants utilizing principal component scores, in order of decreasing eigenvalues. } \references{ R. Khattree and D. N. Naik (2002). Andrews PLots for Multivariate Data: Some New Suggestions and Applications. Journal of Statistical Planning and Inference, Vol. 100, No. 2, pp. 411--425. } \seealso{ \code{\link{polar}}, \code{andrews::andrews} } \examples{ \dontrun{ data(iris) s <- sample(1:4, 4) A <- as.matrix(iris[, s]) f <- as.integer(iris[, 5]) andrewsplot(A, f, style = "pol") } } \keyword{ graphs } pracma/man/strjust.Rd0000644000176200001440000000176412001565513014303 0ustar liggesusers\name{strjust} \alias{strjust} \title{ Justify character vector } \description{ Justify the strings in a character vector. } \usage{ strjust(s, justify = c("left", "right", "center")) } \arguments{ \item{s}{Character vector.} \item{justify}{Whether to justify left, right, or centered.} } \details{ \code{strjust(s)} or \code{strjust(s, justify = ``right'')} returns a right-justified character vector. All strings have the same length, the length of the longest string in \code{s} --- but the strings in \code{s} have been trimmed before. \code{strjust(s, justify = ``left'')} does the same, with all strings left-justified. \code{strjust(s, justify = ``centered'')} returns all string in \code{s} centered. If an odd number of blanks has to be added, one blank more is added to the left than to the right. } \value{ A character vector of the same length. } \seealso{ \code{\link{strTrim}} } \examples{ S <- c("abc", "letters", "1", "2 2") strjust(S, "left") } \keyword{ string } pracma/man/polymul.Rd0000644000176200001440000000211113471575664014275 0ustar liggesusers\name{polymul, polydiv} \alias{polymul} \alias{polydiv} \title{Multiplying and Dividing Polynomials} \description{ Multiply or divide two polynomials given as vectors. } \usage{ polymul(p, q) polydiv(p, q) } \arguments{ \item{p, q}{Vectors representing two polynomials.} } \details{ Polynomial multiplication realized simply by multiplying and summing up all the coefficients. Division is an alias for \code{deconv}. Polynomials are defined from highest to lowest coefficient. } \value{ Vector representing a polynomial. For division, it returns a list with 'd' the result of the division and 'r' the rest. } \note{ \code{conv} also realizes polynomial multiplication, through Fast Fourier Transformation, with the drawback that small imaginary parts may evolve. \code{deconv} can also be used for polynomial division. } \seealso{ \code{conv}, \code{deconv} } \examples{ # Multiply x^2 + x + 1 with itself polymul(c(1, 1, 1), c(0, 1, 1, 1)) #=> 1 2 3 2 1 polydiv(c(1, 2, 3, 2, 1), c(1, 1, 1)) #=> d = c(1,1,1); #=> r = c(0.000000e+00 -1.110223e-16) } \keyword{ math } pracma/man/accumarray.Rd0000644000176200001440000000644512042212424014710 0ustar liggesusers\name{accumarray} \alias{accumarray} \alias{uniq} \title{ Accumulate Vector Elements } \description{ \code{accumarray} groups elements from a data set and applies a function to each group. } \usage{ accumarray(subs, val, sz = NULL, func = sum, fillval = 0) uniq(a, first = FALSE) } \arguments{ \item{subs}{vector or matrix of positive integers, used as indices for the result vector.} \item{val}{numerical vector.} \item{sz}{size of the resulting array.} \item{func}{function to be applied to a vector of numbers.} \item{fillval}{value used to fill the array when there are no indices pointing to that component.} \item{a}{numerical vector.} \item{first}{logical, shall the first or last element encountered be used.} } \details{ \code{A <- accumarray(subs, val)} creates an array \code{A} by accumulating elements of the vector \code{val} using the lines of \code{subs} as indices and applying \code{func} to that accumulated vector. The size of the array can be predetermined by the size vector \code{sz}. \code{A = uniq(a)} returns a vector \code{b} identical to \code{unique(a)} and two other vectors of indices \code{m} and \code{n} such that \code{b == a[m]} and \code{a == b[n]}. } \value{ \code{accumarray} returns an array of size the maximum in each column of \code{subs}, or by \code{sz}. \code{uniq} returns a list with components \item{ b }{vector of unique elements of a.} \item{ m }{vector of indices such that \code{b = a[m]}} \item{ n }{vector of indices such that \code{a = b[n]}} } \note{ The Matlab function \code{accumarray} can also handle sparse matrices. } \seealso{ \code{\link{unique}} } \examples{ ## Examples for accumarray val = 101:105 subs = as.matrix(c(1, 2, 4, 2, 4)) accumarray(subs, val) # [101; 206; 0; 208] val = 101:105 subs <- matrix(c(1,2,2,2,2, 1,1,3,1,3, 1,2,2,2,2), ncol = 3) accumarray(subs, val) # , , 1 # [,1] [,2] [,3] # [1,] 101 0 0 # [2,] 0 0 0 # , , 2 # [,1] [,2] [,3] # [1,] 0 0 0 # [2,] 206 0 208 val = 101:106 subs <- matrix(c(1, 2, 1, 2, 3, 1, 4, 1, 4, 4, 4, 1), ncol = 2, byrow = TRUE) accumarray(subs, val, func = function(x) sum(diff(x))) # [,1] [,2] [,3] [,4] # [1,] 0 1 0 0 # [2,] 0 0 0 0 # [3,] 0 0 0 0 # [4,] 2 0 0 0 val = 101:105 subs = matrix(c(1, 1, 2, 1, 2, 3, 2, 1, 2, 3), ncol = 2, byrow = TRUE) accumarray(subs, val, sz = c(3, 3), func = max, fillval = NA) # [,1] [,2] [,3] # [1,] 101 NA NA # [2,] 104 NA 105 # [3,] NA NA NA ## Examples for uniq a <- c(1, 1, 5, 6, 2, 3, 3, 9, 8, 6, 2, 4) A <- uniq(a); A # A$b 1 5 6 2 3 9 8 4 # A$m 2 3 10 11 7 8 9 12 # A$n 1 1 2 3 4 5 5 6 7 3 4 8 A <- uniq(a, first = TRUE); A # A$m 1 3 4 5 6 8 9 12 ## Example: Subset sum problem # Distribution of unique sums among all combinations of a vectors. allsums <- function(a) { S <- c(); C <- c() for (k in 1:length(a)) { U <- uniq(c(S, a[k], S + a[k])) S <- U$b C <- accumarray(U$n, c(C, 1, C)) } o <- order(S); S <- S[o]; C <- C[o] return(list(S = S, C = C)) } A <- allsums(seq(1, 9, by=2)); A # A$S 1 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 24 25 # A$C 1 1 1 1 1 1 2 2 2 1 2 2 1 2 2 2 1 1 1 1 1 1 1 } \keyword{ array } pracma/man/polyApprox.Rd0000644000176200001440000000325113340252156014736 0ustar liggesusers\name{polyApprox} \alias{polyApprox} \title{ Polynomial Approximation } \description{ Generate a polynomial approximation. } \usage{ polyApprox(f, a, b, n, ...) } \arguments{ \item{f}{function to be approximated.} \item{a, b}{end points of the interval.} \item{n}{degree of the polynomial.} \item{...}{further variables for function \code{f}.} } \details{ Uses the Chebyshev coefficients to derive polynomial coefficients. } \value{ List with four components: \item{p}{the approximating polynomial.} \item{f}{a function evaluating this polynomial.} \item{cheb.coeff}{the Chebyshev coefficients.} \item{estim.prec}{the estimated precision over the given interval.} } \references{ Carothers, N. L. (1998). A Short Course on Approximation Theory. Bowling Green State University. } \note{ The Chebyshev approximation is optimal in the sense of the \eqn{L^1} norm, but not as a solution of the \emph{minimax} problem; for this, an application of the Remez algorithm is needed. } \seealso{ \code{\link{chebApprox}}, \code{\link{polyfit}} } \examples{ ## Example # Polynomial approximation for sin polyApprox(sin, -pi, pi, 9) # $p # [1] 2.197296e-06 0.000000e+00 -1.937495e-04 0.000000e+00 8.317144e-03 # [6] 0.000000e+00 -1.666468e-01 0.000000e+00 9.999961e-01 0.000000e+00 # # $f # function (x) # polyval(p, x) # # $cheb.coeff # [1] 0.06549943 0.00000000 -0.58518036 0.00000000 2.54520983 0.00000000 # [7] -5.16709776 0.00000000 3.14158037 0.00000000 # # $estim.prec # [1] 1.151207e-05 \dontrun{ f <- polyApprox(sin, -pi, pi, 9)$f x <- seq(-pi, pi, length.out = 100) y <- sin(x) - f(x) plot(x, y, type = "l", col = "blue") grid()} } \keyword{ math } pracma/man/randcomb.Rd0000644000176200001440000000120111542722330014335 0ustar liggesusers\name{randcomb} \alias{randcomb} \title{ Random Combination } \description{ Generates a random combination. } \usage{ randcomb(a, m) } \arguments{ \item{a}{numeric vector of some length \code{n}} \item{m}{integer with \code{0 <= m <= n}} } \details{ Generates one random combination of the elements \code{a} of length \code{m}. } \value{ vector of combined elements of \code{a} } \note{ This behavior is different from Matlab/Octave, but does better correspond with the behavior of the perms() function. } \seealso{ \code{\link{combs}}, \code{\link{randperm}} } \examples{ randcomb(seq(2, 10, by=2), m = 3) } \keyword{ arith } pracma/man/pp.Rd0000644000176200001440000000342112042212424013167 0ustar liggesusers\name{ppval} \alias{mkpp} \alias{ppval} \title{ Piecewise Polynomial Structures } \description{ Make or evaluate a piecewise polynomial. } \usage{ mkpp(x, P) ppval(pp, xx) } \arguments{ \item{x}{increasing vector of real numbers.} \item{P}{matrix containing the coefficients of polynomials in each row.} \item{pp}{a piecewise polynomial structure, generated by \code{mkpp}.} \item{xx}{numerical vector} } \details{ \code{pp<-mkpp(x,P)} builds a piecewise polynomial from its breaks \code{x} and coefficients \code{P}. \code{x} is a monotonically increasing vector of length \code{L+1}, and \code{P} is an \code{L-by-k} matrix where each row contains the coefficients of the polynomial of order \code{k}, from highest to lowest exponent, on the interval \code{[x[i],x[i+1])}. \code{ppval(pp,xx)} returns the values of the piecewise polynomial \code{pp} at the entries of the vector \code{xx}. The first and last polynomial will be extended to the left resp. right of the interval \code{[x[1],x[L+1])}. } \value{ \code{mkpp} will return a piecewise polynomial structure, that is a list with components \code{breaks=x}, \code{pieces=P}, \code{order=k} and \code{dim=1} for scalar-valued functions. } \note{ Matlab allows to generate vector-valued piecewise polynomials. This may be included in later versions. } \seealso{ \code{\link{cubicspline}} } \examples{ ## Example: Linear interpolation of the sine function xs <- linspace(0, pi, 10) ys <- sin(xs) P <- matrix(NA, nrow = 9, ncol = 2) for (i in 1:9) { P[i, ] <- c((ys[i+1]-ys[i])/(xs[i+1]-xs[i]), ys[i]) } ppsin <- mkpp(xs, P) \dontrun{ plot(xs, ys); grid() x100 <- linspace(0, pi, 100) lines(x100, sin(x100), col="darkgray") ypp <- ppval(ppsin, x100) lines(x100, ypp, col="red") } } \keyword{ fitting } pracma/man/mldivide.Rd0000644000176200001440000000346412042212424014354 0ustar liggesusers\name{mldivide} \alias{mldivide} \alias{mrdivide} \title{Matlab backslash operator} \description{ Emulate the Matlab backslash operator ``\\'' through QR decomposition. } \usage{ mldivide(A, B, pinv = TRUE) mrdivide(A, B, pinv = TRUE) } \arguments{ \item{A, B}{ Numerical or complex matrices; \code{A} and \code{B} must have the same number of rows (for \code{mldivide}) or the same number of columns (for \code{mrdivide}) } \item{pinv}{logical; shall SVD decomposition be used; default true.} } \details{ \code{mldivide} performs matrix left division (and \code{mrdivide} matrix right division). If \code{A} is scalar it performs element-wise division. If \code{A} is square, \code{mldivide} is roughly the same as \code{inv(A) \%*\% B} except it is computed in a different way --- using QR decomposition. If \code{pinv = TRUE}, the default, the SVD will be used as \code{pinv(t(A)\%*\%A)\%*\%t(A)\%*\%B} to generate results similar to Matlab. Otherwise, \code{qr.solve} will be used. If \code{A} is not square, \code{x <- mldivide(A, b)} returnes a least-squares solution that minimizes the length of the vector \code{A \%*\% x - b} (which is equivalent to \code{norm(A \%*\% x - b, "F")}. } \value{ If \code{A} is an n-by-p matrix and \code{B} n-by-q, then the result of \code{mldivide(A, B)} is a p-by-q matrix (\code{mldivide}). } \note{ \code{mldivide(A, B)} corresponds to \code{A\\B} in Matlab notation. } \examples{ # Solve a system of linear equations A <- matrix(c(8,1,6, 3,5,7, 4,9,2), nrow = 3, ncol = 3, byrow = TRUE) b <- c(1, 1, 1) mldivide(A, b) # 0.06666667 0.06666667 0.06666667 A <- rbind(1:3, 4:6) mldivide(A, c(1,1)) # -0.5 0 0.5 ,i.e. Matlab/Octave result mldivide(A, c(1,1), pinv = FALSE) # -1 1 0 R qr.solve result } \keyword{ math } pracma/man/deeve.Rd0000644000176200001440000000246512042212424013647 0ustar liggesusers\name{deeve} \alias{deeve} \title{ Event Detection in ODE solution } \description{ Detect events in solutions of a differential equation. } \usage{ deeve(x, y, yv = 0, idx = NULL) } \arguments{ \item{x}{vector of (time) points at which the differential equation has been solved.} \item{y}{values of the function(s) that have been computed for the given (time) points.} \item{yv}{point or numeric vector at which the solution is wanted.} \item{idx}{index of functions whose vales shall be returned.} } \details{ Determines when (in \code{x} coordinates) the \code{idx}-th solution function will take on the value \code{yv}. The interpolation is linear for the moment. For points outside the \code{x} interval \code{NA} is returned. } \value{ A (time) point \code{x0} at which the event happens. } \note{ The interpolation is linear only for the moment. } \seealso{ \code{\link{deval}} } \examples{ ## Damped pendulum: y'' = -0.3 y' - sin(y) # y1 = y, y2 = y': y1' = y2, y2' = -0.3*y2 - sin(y1) f <- function(t, y) { dy1 <- y[2] dy2 <- -0.3*y[2] - sin(y[1]) return(c(dy1, dy2)) } sol <- rk4sys(f, 0, 10, c(pi/2, 0), 100) deeve(sol$x, sol$y[,1]) # y1 = 0 : elongation in [sec] # [1] 2.073507 5.414753 8.650250 # matplot(sol$x, sol$y); grid() } \keyword{ ode } pracma/man/strtrim.Rd0000644000176200001440000000136312001565513014264 0ustar liggesusers\name{strTrim} \alias{strTrim} \alias{deblank} \title{ Remove leading and trailing white space. } \description{ Removes leading and trailing white space from a string. } \usage{ strTrim(s) deblank(s) } \arguments{ \item{s}{character string or character vector} } \details{ \code{strTrim} removes leading and trailing white space from a string or from all strings in a character vector. \code{deblank} removes trailing white space only from a string or from all strings in a character vector. } \value{ A character string or character vector with (leading and) trailing white space. } \seealso{ \code{\link{strjust}} } \examples{ s <- c(" abc", "abc ", " abc ", " a b c ", "abc", "a b c") strTrim(s) deblank(s) } \keyword{ string } pracma/man/findpeaks.Rd0000644000176200001440000000526413145434160014533 0ustar liggesusers\name{findpeaks} \alias{findpeaks} \title{ Find Peaks } \description{ Find peaks (maxima) in a time series. } \usage{ findpeaks(x, nups = 1, ndowns = nups, zero = "0", peakpat = NULL, minpeakheight = -Inf, minpeakdistance = 1, threshold = 0, npeaks = 0, sortstr = FALSE) } \arguments{ \item{x}{numerical vector taken as a time series (no NAs allowed)} \item{nups}{minimum number of increasing steps before a peak is reached} \item{ndowns}{minimum number of decreasing steps after the peak} \item{zero}{can be `+', `-', or `0'; how to interprete succeeding steps of the same value: increasing, decreasing, or special} \item{peakpat}{define a peak as a regular pattern, such as the default pattern ``[+]{1,}[-]{1,}''; if a pattern is provided, the parameters \code{nups} and \code{ndowns} are not taken into account} \item{minpeakheight}{the minimum (absolute) height a peak has to have to be recognized as such} \item{minpeakdistance}{the minimum distance (in indices) peaks have to have to be counted} \item{threshold}{the minimum } \item{npeaks}{the number of peaks to return} \item{sortstr}{logical; should the peaks be returned sorted in decreasing oreder of their maximum value} } \details{ This function is quite general as it relies on regular patterns to determine where a peak is located, from beginning to end. } \value{ Returns a matrix where each row represents one peak found. The first column gives the height, the second the position/index where the maximum is reached, the third and forth the indices of where the peak begins and ends --- in the sense of where the pattern starts and ends. } \note{ On Matlab Central there are several realizations for finding peaks, for example ``peakfinder'', ``peakseek'', or ``peakdetect''. And ``findpeaks'' is also the name of a function in the Matlab `signal' toolbox. The parameter names are taken from the ``findpeaks'' function in `signal', but the implementation utilizing regular expressions is unique and fast. } \seealso{ \code{\link{hampel}} } \examples{ x <- seq(0, 1, len = 1024) pos <- c(0.1, 0.13, 0.15, 0.23, 0.25, 0.40, 0.44, 0.65, 0.76, 0.78, 0.81) hgt <- c(4, 5, 3, 4, 5, 4.2, 2.1, 4.3, 3.1, 5.1, 4.2) wdt <- c(0.005, 0.005, 0.006, 0.01, 0.01, 0.03, 0.01, 0.01, 0.005, 0.008, 0.005) pSignal <- numeric(length(x)) for (i in seq(along=pos)) { pSignal <- pSignal + hgt[i]/(1 + abs((x - pos[i])/wdt[i]))^4 } findpeaks(pSignal, npeaks=3, threshold=4, sortstr=TRUE) \dontrun{ plot(pSignal, type="l", col="navy") grid() x <- findpeaks(pSignal, npeaks=3, threshold=4, sortstr=TRUE) points(x[, 2], x[, 1], pch=20, col="maroon")} } \keyword{ timeseries } pracma/man/orth.Rd0000644000176200001440000000144612037611317013541 0ustar liggesusers\name{orth} \alias{orth} \title{ Range Space } \description{ Range space or image of a matrix. } \usage{ orth(M) } \arguments{ \item{M}{Numeric matrix; vectors will be considered as column vectors.} } \details{ \code{B=orth(A)} returns an orthonormal basis for the range of \code{A}. The columns of \code{B} span the same space as the columns of \code{A}, and the columns of \code{B} are orthogonal to each other. The number of columns of \code{B} is the rank of \code{A}. } \value{ Matrix of orthogonal columns, spanning the image of \code{M}. } \references{ Trefethen, L. N., and D. Bau III. (1997). Numerical Linear Algebra. SIAM, Philadelphia. } \seealso{ \code{\link{nullspace}} } \examples{ M <- matrix(1:12, 3, 4) Rank(M) #=> 2 orth(M) } \keyword{ array } pracma/man/size.Rd0000644000176200001440000000131411652316301013526 0ustar liggesusers\name{size} \alias{size} \title{Size of Matrix} \description{ Provides the dimensions of \code{x}. } \usage{ size(x, k) } \arguments{ \item{x}{vector, matrix, or array} \item{k}{integer specifying a particular dimension} } \details{ Returns the number of dimensions as \code{length(x)}. Vector will be treated as a single row matrix. } \value{ vector containing the dimensions of \code{x}, or the \code{k}-th dimension if \code{k} is not missing. } \note{ The result will differ from Matlab when \code{x} is a character vector. } \seealso{ \code{\link[base]{dim}} } \examples{ size(1:8) size(matrix(1:8, 2, 4)) # 2 4 size(matrix(1:8, 2, 4), 2) # 4 size(matrix(1:8, 2, 4), 3) # 1 } \keyword{array} pracma/man/shooting.Rd0000644000176200001440000000410513024246505014412 0ustar liggesusers\name{shooting} \alias{shooting} \title{Shooting Method} \description{ The shooting method solves the boundary value problem for second-order differential equations. } \usage{ shooting(f, t0, tfinal, y0, h, a, b, itermax = 20, tol = 1e-6, hmax = 0) } \arguments{ \item{f}{function in the differential equation \eqn{y'' = f(x, y, y')}.} \item{t0, tfinal}{start and end points of the interval.} \item{y0}{starting value of the solution.} \item{h}{function defining the boundary condition as a function at the end point of the interval.} \item{a, b}{two guesses of the derivative at the start point.} \item{itermax}{maximum number of iterations for the secant method.} \item{tol}{tolerance to be used for stopping and in the \code{ode45} solver.} \item{hmax}{maximal step size, to be passed to the solver.} } \details{ A second-order differential equation is solved with boundary conditions \code{y(t0) = y0} at the start point of the interval, and \code{h(y(tfinal), dy/dt(tfinal)) = 0} at the end. The zero of \code{h} is found by a simple secant approach. } \value{ Returns a list with two components, \code{t} for grid (or `time') points between \code{t0} and \code{tfinal}, and \code{y} the solution of the differential equation evaluated at these points. } \references{ L. V. Fausett (2008). Applied Numerical Analysis Using MATLAB. Second Edition, Pearson Education Inc. } \note{ Replacing secant with Newton's method would be an easy exercise. The same for replacing \code{ode45} with some other solver. } \seealso{ \code{\link{bvp}} } \examples{ #-- Example 1 f <- function(t, y1, y2) -2*y1*y2 h <- function(u, v) u + v - 0.25 t0 <- 0; tfinal <- 1 y0 <- 1 sol <- shooting(f, t0, tfinal, y0, h, 0, 1) \dontrun{ plot(sol$t, sol$y[, 1], type='l', ylim=c(-1, 1)) xs <- linspace(0, 1); ys <- 1/(xs+1) lines(xs, ys, col="red") lines(sol$t, sol$y[, 2], col="gray") grid()} #-- Example 2 f <- function(t, y1, y2) -y2^2 / y1 h <- function(u, v) u - 2 t0 <- 0; tfinal <- 1 y0 <- 1 sol <- shooting(f, t0, tfinal, y0, h, 0, 1) } \keyword{ode} pracma/man/detrend.Rd0000644000176200001440000000224311563500200014175 0ustar liggesusers\name{detrend} \alias{detrend} \title{ Remove Linear Trends } \description{ Removes the mean value or (piecewise) linear trend from a vector or from each column of a matrix. } \usage{ detrend(x, tt = 'linear', bp = c()) } \arguments{ \item{x}{vector or matrix, columns considered as the time series.} \item{tt}{trend type, `constant' or `linear', default is `linear'.} \item{bp}{break points, indices between 1 and \code{nrow(x)}.} } \details{ \code{detrend} computes the least-squares fit of a straight line (or composite line for piecewise linear trends) to the data and subtracts the resulting function from the data. To obtain the equation of the straight-line fit, use \code{polyfit}. } \value{ removes the mean or (piecewise) linear trend from \code{x} and returns it in \code{y=detrend(x)}, that is \code{x-y} \emph{is} the linear trend. } \note{ Detrending is often used for FFT processing. } \seealso{ \code{\link{polyfit}} } \examples{ t <- 1:9 x <- c(0, 2, 0, 4, 4, 4, 0, 2, 0) x - detrend(x, 'constant') x - detrend(x, 'linear') y <- detrend(x, 'linear', 5) \dontrun{ plot(t, x, col="blue") lines(t, x - y, col="red") grid()} } \keyword{ math } pracma/man/circlefit.Rd0000644000176200001440000000274213630250433014527 0ustar liggesusers\encoding{utf8} \name{circlefit} \alias{circlefit} \title{Fitting a Circle} \description{ Fitting a circle from points in the plane } \usage{ circlefit(xp, yp, fast = TRUE) } \arguments{ \item{xp, yp}{Vectors representing the x and y coordinates of plane points} \item{fast}{deprecated; will not be used.} } \details{ This routine finds an `algebraic' solution based on a linear fit. The value to be minimized is the distance of the given points to the nearest point on the circle along a radius. } \value{ Returns x- and y-coordinates of the center and the radius as a vector of length 3. Writes the RMS error of the (radial) distance of the original points to the circle directly onto the console. } \references{ Gander, W., G. H. Golub, and R. Strebel (1994). Fitting of Circles and Ellipses --- Least Squares Solutions. ETH Zürich, Technical Report 217, Institut für Wissenschaftliches Rechnen. } \examples{ # set.seed(8421) n <- 20 w <- 2*pi*runif(n) xp <- cos(w) + 1 + 0.25 * (runif(n) - 0.5) yp <- sin(w) + 1 + 0.25 * (runif(n) - 0.5) circe <- circlefit(xp, yp) #=> 0.9899628 1.0044920 1.0256633 # RMS error: 0.07631986 \dontrun{ x0 <- circe[1]; y0 <- circe[2]; r0 <- circe[3] plot(c(-0.2, 2.2), c(-0.2, 2.2), type="n", asp=1) grid() abline(h=0, col="gray"); abline(v=0, col="gray") points(xp, yp, col="darkred") w <- seq(0, 2*pi, len=100) xx <- r0 * cos(w) + x0 yy <- r0 * sin(w) + y0 lines(xx, yy, col="blue")} } \keyword{ fitting } pracma/man/logspace.Rd0000644000176200001440000000166311542066276014373 0ustar liggesusers\name{logspace} \alias{logspace} \alias{logseq} \title{Log-linearly Spaced Sequences} \description{ Generate log-linearly spaced sequences. } \usage{ logspace(x1, x2, n = 50) logseq(x1, x2, n = 100) } \arguments{ \item{x1}{numeric scalar specifying starting point} \item{x2}{numeric scalar specifying ending point} \item{n}{numeric scalar specifying number of points to be generated} } \details{ These functions will generate logarithmically resp. exponentially spaced points between \code{x1} and \code{x2} resp. \code{10^x1} and \code{10^x2}. If \eqn{n < 2}, the result will be the ending point \code{x2}. For \code{logspace()}, if \code{x2 = pi}, the endpoint will be \code{pi} and not \code{10^pi}! } \value{ vector containing \code{n} points between \code{x1} and \code{x2} inclusive. } \seealso{ \code{\link{logspace}}, \code{\link{seq}} } \examples{ logspace(1, pi, 36) logseq(0.05, 1, 20) } \keyword{ manip } pracma/man/quadgr.Rd0000644000176200001440000000246611577725153014067 0ustar liggesusers\name{quadgr} \alias{quadgr} \title{ Gaussian Quadrature with Richardson Extrapolation } \description{ Gaussian 12-point quadrature with Richardson extrapolation. } \usage{ quadgr(f, a, b, tol = .Machine$double.eps^(1/2), ...) } \arguments{ \item{f}{integrand as function, may have singularities at the endpoints.} \item{a, b}{endpoints of the integration interval.} \item{tol}{relative tolerence.} \item{\ldots}{Additional parameters to be passed to the function \code{f}.} } \details{ \code{quadgr} uses a 12-point Gauss-Legendre quadrature. The error estimate is based on successive interval bisection. Richardson extrapolation accelerates the convergence for some integrals, especially integrals with endpoint singularities. Through some preprocessing infinite intervals can also be handled. } \value{ List with \code{value} and \code{rel.err}. } \author{ Copyright (c) 2009 Jonas Lundgren for the Matlab function \code{quadgr} available on MatlabCentral under the BSD license. R re-implementation by HwB, email: , in 2011. } \seealso{ \code{gaussLegendre} } \examples{ ## Dilogarithm function flog <- function(t) log(1-t)/t quadgr(flog, 1, 0, tol = 1e-12) # value # 1.6449340668482 , is pi^2/6 = 1.64493406684823 # rel.err # 2.07167616395054e-13 } \keyword{ math } pracma/man/gammainc.Rd0000644000176200001440000000301113037137333014331 0ustar liggesusers\name{gammainc} \alias{gammainc} \alias{incgam} \title{ Incomplete Gamma Function } \description{ Lower and upper incomplete gamma function. } \usage{ gammainc(x, a) incgam(x, a) } \arguments{ \item{x}{positive real number.} \item{a}{real number.} } \details{ \code{gammainc} computes the lower and upper incomplete gamma function, including the regularized gamma function. The lower and upper incomplete gamma functions are defined as \deqn{\gamma(x, a) = \int_0^x e^{-t} \, t^{a-1} \, dt} and \deqn{\Gamma(x, a) = \int_x^{\infty} e^{-t} \, t^{a-1} \, dt} while the regularized incomplete gamma function is \eqn{\gamma(x, a)/\Gamma(a)}. \code{incgam} (a name used in Pari/GP) computes the upper incomplete gamma function alone, applying the R function \code{pgamma}. The accuracy is thus much higher. It works for \code{a >= -1}, for even smaller values a recursion will give the result. } \value{ \code{gammainc} returns a list with the values of the lower, the upper, and regularized lower incomplete gamma function. \code{incgam} only returns the value of the incomplete upper gamma function. } \references{ Zhang, Sh., and J. Jin (1996). Computation of Special Functions. Wiley-Interscience, New York. } \note{ Directly converting Fortran code is often easier than translating Matlab code generated with f2matlab. } \seealso{ \code{\link{gamma}}, \code{\link{pgamma}} } \examples{ gammainc( 1.5, 2) gammainc(-1.5, 2) incgam(3, 1.2) incgam(3, 0.5); incgam(3, -0.5) } \keyword{ specfun } pracma/man/rmserr.Rd0000644000176200001440000000204012042212424014056 0ustar liggesusers\name{rmserr} \alias{rmserr} \title{ Accuracy Measures } \description{ Calculates different accuracy measures, most prominently RMSE. } \usage{ rmserr(x, y, summary = FALSE) } \arguments{ \item{x, y}{two vectors of real numbers} \item{summary}{logical; should a summary be printed to the screen?} } \details{ Calculates six different measures of accuracy for two given vectors or sequences of real numbers: \tabular{ll}{ MAE \tab Mean Absolute Error\cr MSE \tab Mean Squared Error\cr RMSE \tab Root Mean Squared Error\cr MAPE \tab Mean Absolute Percentage Error\cr LMSE \tab Normalized Mean Squared Error\cr rSTD \tab relative Standard Deviation } } \value{ Returns a list with different accuracy measures. } \references{ Gentle, J. E. (2009). Computational Statistics, section 10.3. Springer Science+Business Media LCC, New York. } \note{ Often used in Data Mining for \emph{predicting} the accuracy of predictions. } \examples{ x <- rep(1, 10) y <- rnorm(10, 1, 0.1) rmserr(x, y, summary = TRUE) } \keyword{ stat } pracma/man/dblquad.Rd0000644000176200001440000000340712117654317014206 0ustar liggesusers\name{dblquad} \alias{dblquad} \alias{triplequad} \title{ Double and Triple Integration } \description{ Numerically evaluate double integral over rectangle. } \usage{ dblquad(f, xa, xb, ya, yb, dim = 2, ..., subdivs = 300, tol = .Machine$double.eps^0.5) triplequad(f, xa, xb, ya, yb, za, zb, subdivs = 300, tol = .Machine$double.eps^0.5, ...) } \arguments{ \item{f}{function of two variables, the integrand.} \item{xa, xb}{left and right endpoint for first variable.} \item{ya, yb}{left and right endpoint for second variable.} \item{za, zb}{left and right endpoint for third variable.} \item{dim}{which variable to integrate first.} \item{subdivs}{number of subdivisions to use.} \item{tol}{relative tolerance to use in \code{integrate}.} \item{\ldots}{additional parameters to be passed to the integrand.} } \details{ Function \code{dblquad} applies the internal single variable integration function \code{integrate} two times, once for each variable. Function \code{triplequad} reduces the problem to \code{dblquad} by first integrating over the innermost variable. } \value{ Numerical scalar, the value of the integral. } \seealso{ \code{\link{integrate}}, \code{\link{quad2d}}, \code{\link{simpson2d}} } \examples{ f1 <- function(x, y) x^2 + y^2 dblquad(f1, -1, 1, -1, 1) # 2.666666667 , i.e. 8/3 . err = 0 f2 <- function(x, y) y*sin(x)+x*cos(y) dblquad(f2, pi, 2*pi, 0, pi) # -9.869604401 , i.e. -pi^2, err = 0 # f3 <- function(x, y) sqrt((1 - (x^2 + y^2)) * (x^2 + y^2 <= 1)) f3 <- function(x, y) sqrt(pmax(0, 1 - (x^2 + y^2))) dblquad(f3, -1, 1, -1, 1) # 2.094395124 , i.e. 2/3*pi , err = 2e-8 f4 <- function(x, y, z) y*sin(x)+z*cos(x) triplequad(f4, 0,pi, 0,1, -1,1) # - 2.0 => -2.220446e-16 } \keyword{ math } pracma/man/zeta.Rd0000644000176200001440000000267413645673711013550 0ustar liggesusers\name{zeta} \alias{zeta} \title{ Riemann Zeta Function } \description{ Riemann's zeta function valid in the entire complex plane. } \usage{ zeta(z) } \arguments{ \item{z}{Real or complex number or a numeric or complex vector.} } \details{ Computes the zeta function for complex arguments using a series expansion for Dirichlet's eta function. Accuracy is about 7 significant digits for \code{abs(z)<50}, drops off with higher absolute values. } \value{ Returns a complex vector of function values. } \references{ Zhang, Sh., and J. Jin (1996). Computation of Special Functions. Wiley-Interscience, New York. } \note{ Copyright (c) 2001 Paul Godfrey for a Matlab version available on Mathwork's Matlab Central under BSD license. } \seealso{ \code{\link{gammaz}}, \code{\link{eta}} } \examples{ ## First zero on the critical line s = 0.5 + i t \dontrun{ x <- seq(0, 20, len=1001) z <- 0.5 + x*1i fr <- Re(zeta(z)) fi <- Im(zeta(z)) fa <- abs(zeta(z)) plot(x, fa, type="n", xlim = c(0, 20), ylim = c(-1.5, 2.5), xlab = "Imaginary part (on critical line)", ylab = "Function value", main = "Riemann's Zeta Function along the critical line") lines(x, fr, col="blue") lines(x, fi, col="darkgreen") lines(x, fa, col = "red", lwd = 2) points(14.1347, 0, col = "darkred") legend(0, 2.4, c("real part", "imaginary part", "absolute value"), lty = 1, lwd = c(1, 1, 2), col = c("blue", "darkgreen", "red")) grid()} } \keyword{ specfun } pracma/man/newtonsys.Rd0000644000176200001440000000415412204446562014641 0ustar liggesusers\name{newtonsys} \alias{newtonsys} \title{Newton Method for Nonlinear Systems} \description{ Newton's method applied to multivariate nonlinear functions. } \usage{ newtonsys(Ffun, x0, Jfun = NULL, ..., maxiter = 100, tol = .Machine$double.eps^(1/2)) } \arguments{ \item{Ffun}{\code{m} functions of \code{n} variables.} \item{Jfun}{Function returning a square \code{n}-by-\code{n} matrix (of partial derivatives) or \code{NULL}, the default.} \item{x0}{Numeric vector of length \code{n}.} \item{maxiter}{Maximum number of iterations.} \item{tol}{Tolerance, relative accuracy.} \item{...}{Additional parameters to be passed to f.} } \details{ Solves the system of equations applying Newton's method with the univariate derivative replaced by the Jacobian. } \value{ List with components: \code{zero} the root found so far, \code{fnorm} the square root of sum of squares of the values of f, and \code{iter} the number of iterations needed. } \references{ Quarteroni, A., R. Sacco, and F. Saleri (2007). Numerical Mathematics. Second Edition, Springer-Verlag, Berlin Heidelberg. } \note{ TODO: better error checking, e.g. when the Jacobian is not invertible. } \seealso{ \code{\link{newtonRaphson}}, \code{\link{broyden}} } \examples{ ## Example from Quarteroni & Saleri F1 <- function(x) c(x[1]^2 + x[2]^2 - 1, sin(pi*x[1]/2) + x[2]^3) newtonsys(F1, x0 = c(1, 1)) # zero: 0.4760958 -0.8793934 ## Find the roots of the complex function sin(z)^2 + sqrt(z) - log(z) F2 <- function(x) { z <- x[1] + x[2]*1i fz <- sin(z)^2 + sqrt(z) - log(z) c(Re(fz), Im(fz)) } newtonsys(F2, c(1, 1)) # $zero 0.2555197 0.8948303 , i.e. z0 = 0.2555 + 0.8948i # $fnorm 2.220446e-16 # $niter 8 ## Two more problematic examples F3 <- function(x) c(2*x[1] - x[2] - exp(-x[1]), -x[1] + 2*x[2] - exp(-x[2])) newtonsys(F3, c(0, 0)) # $zero 0.5671433 0.5671433 # $fnorm 0 # $niter 4 \dontrun{ F4 <- function(x) # Dennis Schnabel c(x[1]^2 + x[2]^2 - 2, exp(x[1] - 1) + x[2]^3 - 2) newtonsys(F4, c(2.0, 0.5)) # will result in an error ``missing value in ... err=ncol(A)}.} \item{b}{numerical vector with \code{length(b) == nrow(A)}.} } \details{ Solves (overdetermined) systems of linear equations via QR decomposition. } \value{ The solution of the system as vector. } \references{ Trefethen, L. N., and D. Bau III. (1997). Numerical Linear Algebra. SIAM, Society for Industrial and Applied Mathematics, Philadelphia. } \seealso{ \code{\link{householder}} } \examples{ A <- matrix(c(0,-4,2, 6,-3,-2, 8,1,-1), 3, 3, byrow=TRUE) b <- c(-2, -6, 7) qrSolve(A, b) ## Solve an overdetermined linear system of equations A <- matrix(c(1:8,7,4,2,3,4,2,2), ncol=3, byrow=TRUE) b <- rep(6, 5) x <- qrSolve(A, b) qr.solve(A, rep(6, 5)); x } \keyword{ array } pracma/man/str2num.Rd0000644000176200001440000000301712056073543014177 0ustar liggesusers\name{str2num} \alias{str2num} \alias{num2str} \title{ Converting string to number (Matlab style) } \description{ Functions for converting strings to numbers and numbers to strings. } \usage{ str2num(S) num2str(A, fmt = 3) } \arguments{ \item{S}{string containing numbers (in Matlab format).} \item{A}{numerical vector or matrix.} \item{fmt}{format string, or integer indicating number of decimals.} } \details{ \code{str2num} converts a string containing numbers into a numerical object. The string can begin and end with '[' and ']', numbers can be separated with blanks or commas; a semicolon within the brackets indicates a new row for matrix input. When a semicolon appears behind the braces, no output is shown on the command line. \code{num2str} converts a numerical object, vector or matrix, into a character object of the same size. \code{fmt} will be a format string for use in \code{sprintf}, or an integer \code{n} being used in \code{'\%.nf'}. } \value{ Returns a vector or matrix of the same size, converted to strings, respectively numbers. } \seealso{ \code{\link{sprintf}} } \examples{ str1 <- " [1 2 3; 4, 5, 6; 7,8,9] " str2num(str1) # matrix(1:9, nrow = 3, ncol = 3, byrow = TRUE) # str2 <- " [1 2 3; 45, 6; 7,8,9] " # str2num(str2) # Error in str2num(str2) : # All rows in Argument 's' must have the same length. A <- matrix(c(pi, 0, exp(1), 1), 2, 2) B <- num2str(A, 2); b <- dim(B) B <- as.numeric(B); dim(B) <- b B # [,1] [,2] # [1,] 3.14 2.72 # [2,] 0.00 1.00 } \keyword{ manip } pracma/man/eigjacobi.Rd0000644000176200001440000000252212062032441014466 0ustar liggesusers\name{eigjacobi} \alias{eigjacobi} \title{ Jacobi Eigenvalue Method } \description{ Jacobi's iteration method for eigenvalues and eigenvectors. } \usage{ eigjacobi(A, tol = .Machine$double.eps^(2/3)) } \arguments{ \item{A}{a real symmetric matrix.} \item{tol}{requested tolerance.} } \details{ The Jacobi eigenvalue method repeatedly performs (Givens) transformations until the matrix becomes almost diagonal. } \value{ Returns a list with components \code{V}, a matrix containing the eigenvectors as columns, and \code{D} a vector of the eigenvalues. } \note{ This R implementation works well up to 50x50-matrices. } \references{ Mathews, J. H., and K. D. Fink (2004). Numerical Methods Using Matlab. Fourth edition, Pearson education, Inc., New Jersey. } \seealso{ \code{\link{eig}} } \examples{ A <- matrix(c( 1.06, -0.73, 0.77, -0.67, -0.73, 2.64, 1.04, 0.72, 0.77, 1.04, 3.93, -2.14, -0.67, 0.72, -2.14, 2.04), 4, 4, byrow = TRUE) eigjacobi(A) # $V # [,1] [,2] [,3] [,4] # [1,] 0.87019414 -0.3151209 0.1975473 -0.3231656 # [2,] 0.11138094 0.8661855 0.1178032 -0.4726938 # [3,] 0.07043799 0.1683401 0.8273261 0.5312548 # [4,] 0.47475776 0.3494040 -0.5124734 0.6244140 # # $D # [1] 0.66335457 3.39813189 5.58753257 0.02098098 } \keyword{ math } pracma/man/subspace.Rd0000644000176200001440000000176514072313323014373 0ustar liggesusers\name{subspace} \alias{subspace} \title{ Angle between two subspaces } \description{ Finds the angle between two subspaces. } \usage{ subspace(A, B) } \arguments{ \item{A, B}{Numeric matrices; vectors will be considered as column vectors. These matrices must have the same number or rows.} } \details{ Finds the angle between two subspaces specified by the columns of A and B. } \value{ An angle in radians. } \references{ Strang, G. (1998). Introduction to Linear Algebra. Wellesley-Cambridge Press. } \note{ It is not necessary that two subspaces be the same size in order to find the angle between them. Geometrically, this is the angle between two hyperplanes embedded in a higher dimensional space. } \seealso{ \code{\link{orth}} } \examples{ 180 * subspace(c(1, 2), c(2, 1)) / pi #=> 36.87 180 * subspace(c(0, 1), c(1, 2)) / pi #=> 26.565 H <- hadamard(8) A <- H[, 2:4] B <- H[, 5:8] subspace(A, B) #=> 1.5708 or pi/2, i.e. A and B are orthogonal } \keyword{ array } pracma/man/erfz.Rd0000644000176200001440000000262712250325322013530 0ustar liggesusers\name{erf} \alias{erf} \alias{erfinv} \alias{erfc} \alias{erfcinv} \alias{erfcx} \alias{erfz} \alias{erfi} \title{ Error Functions and Inverses (Matlab Style) } \description{ The error or Phi function is a variant of the cumulative normal (or Gaussian) distribution. } \usage{ erf(x) erfinv(y) erfc(x) erfcinv(y) erfcx(x) erfz(z) erfi(z) } \arguments{ \item{x, y}{vector of real numbers.} \item{z}{real or complex number; must be a scalar.} } \details{ \code{erf} and \code{erfinv} are the error and inverse error functions.\cr \code{erfc} and \code{erfcinv} are the complementary error function and its inverse.\cr \code{erfcx} is the scaled complementary error function.\cr \code{erfz} is the complex, \code{erfi} the imaginary error function. } \value{ Real or complex number(s), the value(s) of the function. } \author{ First version by Hans W Borchers; vectorized version of \code{erfz} by Michael Lachmann. } \note{ For the complex error function we used Fortran code from the book S. Zhang & J. Jin ``Computation of Special Functions'' (Wiley, 1996). } \seealso{ \code{\link{pnorm}} } \examples{ x <- 1.0 erf(x); 2*pnorm(sqrt(2)*x) - 1 # [1] 0.842700792949715 # [1] 0.842700792949715 erfc(x); 1 - erf(x); 2*pnorm(-sqrt(2)*x) # [1] 0.157299207050285 # [1] 0.157299207050285 # [1] 0.157299207050285 erfz(x) # [1] 0.842700792949715 erfi(x) # [1] 1.650425758797543 } \keyword{ stat } pracma/man/distmat.Rd0000644000176200001440000000331412156654302014231 0ustar liggesusers\name{distmat} \alias{distmat} \alias{pdist} \alias{pdist2} \title{Distance Matrix} \description{ Computes the Euclidean distance between rows of two matrices. } \usage{ distmat(X, Y) pdist(X) pdist2(X, Y) } \arguments{ \item{X}{matrix of some size \code{m x k}; vector will be taken as row matrix.} \item{Y}{matrix of some size \code{n x k}; vector will be taken as row matrix.} } \details{ Computes Euclidean distance between two vectors A and B as: \code{||A-B|| = sqrt ( ||A||^2 + ||B||^2 - 2*A.B )} and vectorizes to rows of two matrices (or vectors). \code{pdist2} is an alias for \code{distmat}, while \code{pdist(X)} is the same as \code{distmat(X, X)}. } \value{ matrix of size \code{m x n} if \code{x} is of size \code{m x k} and \code{y} is of size \code{n x k}. } \references{ Copyright (c) 1999 Roland Bunschoten for a Matlab version on MatlabCentral under the name \code{distance.m}. Translated to R by Hans W Borchers. } \note{ If \code{a} is \code{m x r} and \code{b} is \code{n x r} then \code{apply(outer(a,t(b),"-"),c(1,4),function(x)sqrt(sum(diag(x*x))))} is the \code{m x n} matrix of distances between the \code{m} rows of \code{a} and \code{n} rows of \code{b}. This can be modified as necessary, if one wants to apply distances other than the euclidean. BUT: The code shown here is 10-100 times faster, utilizing the similarity between Euclidean distance and matrix operations. } \seealso{ \code{\link{dist}} } \examples{ A <- c(0.0, 0.0) B <- matrix(c( 0,0, 1,0, 0,1, 1,1), nrow=4, ncol = 2, byrow = TRUE) distmat(A, B) #=> 0 1 1 sqrt(2) X <- matrix(rep(0.5, 5), nrow=1, ncol=5) Y <- matrix(runif(50), nrow=10, ncol=5) distmat(X, Y) } \keyword{ array } pracma/man/sind.Rd0000644000176200001440000000331412764776254013541 0ustar liggesusers\name{sind,cosd,tand, etc.} \alias{sind} \alias{cosd} \alias{tand} \alias{cotd} \alias{asind} \alias{acosd} \alias{atand} \alias{acotd} \alias{secd} \alias{cscd} \alias{asecd} \alias{acscd} \alias{atan2d} \title{ Trigonometric Functions in Degrees } \description{ Trigonometric functions expecting input in degrees, not radians. } \usage{ sind(x) cosd(x) tand(x) cotd(x) asind(x) acosd(x) atand(x) acotd(x) secd(x) cscd(x) asecd(x) acscd(x) atan2d(x1, x2) } \arguments{ \item{x, x1, x2}{numeric or complex scalars or vectors} } \details{ The usual trigonometric functions with input values as scalar or vector in degrees. Note that \code{tan(x)} with fractional part does not return \code{NaN} as \code{tanpi(x)}, but is computed as \code{sind(x)/cosd(x)}. For \code{atan2d} the inputs \code{x1,x2} can be both degrees or radians, but don't mix! The result is in degrees, of course. } \value{ Returns a scalar or vector of numeric values. } \note{ These function names are available in Matlab, that is the reason they have been added to the `pracma' package. } \seealso{ Other trigonometric functions in R. } \examples{ # sind(x) and cosd(x) are accurate for x which are multiples # of 90 and 180 degrees, while tand(x) is problematic. x <- seq(0, 720, by = 90) sind(x) # 0 1 0 -1 0 1 0 -1 0 cosd(x) # 1 0 -1 0 1 0 -1 0 1 tand(x) # 0 Inf 0 -Inf 0 Inf 0 -Inf 0 cotd(x) # Inf 0 -Inf 0 Inf 0 -Inf 0 Inf x <- seq(5, 85, by = 20) asind(sind(x)) # 5 25 45 65 85 asecd(sec(x)) tand(x) # 0.08748866 0.46630766 1.00000000 ... atan2d(1, 1) # 45 } \keyword{ math } pracma/man/findmins.Rd0000644000176200001440000000275611753302415014401 0ustar liggesusers\name{findmins} \alias{findmins} \title{ Find All Minima } \description{ Finding all local(!) minima of a unvariate function in an interval by splitting the interval in many small subintervals. } \usage{ findmins(f, a, b, n = 100, tol = .Machine$double.eps^(2/3), ...) } \arguments{ \item{f}{functions whose minima shall be found.} \item{a, b}{endpoints of the interval.} \item{n}{number of subintervals to generate and search.} \item{tol}{has no effect at this moment.} \item{\ldots}{Additional parameters to be passed to the function.} } \details{ Local minima are found by looking for one minimum in each subinterval. It will be found by applying \code{optimize} to any two adjacent subinterval where the first slope is negative and the second one positive. If the function is minimal on a whole subinterval, this will cause problems. If some minima are apparently not found, increase the number of subintervals. Note that the endpoints of the interval will never be considered to be local minima. The function need not be vectorized. } \value{ Numeric vector with the x-positions of all minima found in the interval. } \seealso{ \code{\link{optimize}} } \examples{ fun <- function(x) x * cos(0.1*exp(x)) * sin(0.1*pi*exp(x)) \dontrun{ezplot(fun, 0, 5, n = 1001)} # If n is smaller, the rightmost minimum will not be found. findmins(fun, 0, 5, n= 1000) # 2.537727 3.248481 3.761840 4.023021 4.295831 # 4.455115 4.641481 4.756263 4.897461 4.987802 } \keyword{ optimize } pracma/man/tictoc.Rd0000644000176200001440000000147312054177676014070 0ustar liggesusers\name{tic,toc} \alias{tic} \alias{toc} \title{MATLAB timer functions} \description{ Provides stopwatch timer. Function \code{tic} starts the timer and \code{toc} updates the elapsed time since the timer was started. } \usage{ tic(gcFirst=FALSE) toc(echo=TRUE) } \arguments{ \item{gcFirst}{logical scalar. If \code{TRUE}, perform garbage collection prior to starting stopwatch} \item{echo}{logical scalar. If \code{TRUE}, print elapsed time to screen} } \details{ Provides analog to \code{\link[base]{system.time}}. Function \code{toc} can be invoked multiple times in a row. } \value{ \code{toc} invisibly returns the elapsed time as a named scalar (vector). } \examples{ tic() for(i in 1:100) mad(runif(1000)) # kill time toc() } \author{ P. Roebuck \email{proebuck@mdanderson.org} } \keyword{utilities} pracma/man/moler.Rd0000644000176200001440000000074112465405723013707 0ustar liggesusers\name{moler} \alias{moler} \title{Moler Matrix} \description{ Generate the Moler matrix of size \code{n x n}. The Moler matrix is for testing eigenvalue computations. } \usage{ moler(n) } \arguments{ \item{n}{integer} } \details{ The Moler matrix for testing eigenvalue computations is a symmetric matrix with exactly one small eigenvalue. } \value{ matrix of size \code{n x n} } \seealso{ \code{\link{wilkinson}} } \examples{ (a <- moler(10)) min(eig(a)) } \keyword{ specmat } pracma/man/whittaker.Rd0000644000176200001440000000347313034767277014610 0ustar liggesusers\name{whittaker} \alias{whittaker} \title{ Whittaker Smoothing } \description{ Smoothing of time series using the Whittaker-Henderson approach. } \usage{ whittaker(y, lambda = 1600, d = 2) } \arguments{ \item{y}{signal to be smoothed.} \item{lambda}{smoothing parameter (rough 50..1e4 smooth); the default value of 1600 has been recommended in the literature.} \item{d}{order of differences in penalty (generally 2)} } \details{ The Whittaker smoother family was first presented by Whittaker in 1923 for life tables, based on penalized least squares. These ideas were revived by Paul Eilers, Leiden University, in 2003. This approach is also known as Whittaker-Henderson smoothing. The smoother attempts to both fit a curve that represents the raw data, but is penalized if subsequent points vary too much. Mathematically it is a large, but sparse optimization problem that can be expressed in a few lines of Matlab or R code. } \value{ A smoothed time series. } \note{ This is a version that avoids package 'SparseM'. } \author{ An R version, based on Matlab code by P. Eilers in 2002, has been published by Nicholas Lewin-Koh on the R-help mailing list in Feb. 2004, and in private communication to the author of this package. } \references{ P. H. C. Eilers (2003). A Perfect Smoother. Analytical Chemistry, Vol. 75, No. 14, pp. 3631--3636. Wilson, D. I. (2006). The Black Art of Smoothing. Electrical and Automation Technology, June/July issue. } \seealso{ \code{\link{supsmu}}, \code{\link{savgol}}, \code{ptw::whit2} } \examples{ # **Sinosoid test function** ts <- sin(2*pi*(1:1000)/200) t1 <- ts + rnorm(1000)/10 t3 <- whittaker(t1, lambda = 1600) \dontrun{ plot(1:1000, t1, col = "grey") lines(1:1000, ts, col="blue") lines(1:1000, t3, col="red")} } \keyword{ timeseries } pracma/man/interp1.Rd0000644000176200001440000000457012553020431014142 0ustar liggesusers\name{interp1} \alias{interp1} \title{ One-dimensional Interpolation } \description{ One-dimensional interpolation of points. } \usage{ interp1(x, y, xi = x, method = c("linear", "constant", "nearest", "spline", "cubic")) } \arguments{ \item{x}{Numeric vector; points on the x-axis; at least two points require; will be sorted if necessary.} \item{y}{Numeric vector; values of the assumed underlying function; \code{x} and \code{y} must be of the same length.} \item{xi}{Numeric vector; points at which to compute the interpolation; all points must lie between \code{min(x)} and \code{max(x)}.} \item{method}{One of ``constant", ``linear", ``nearest", ``spline", or ``cubic"; default is ``linear"} } \details{ Interpolation to find \code{yi}, the values of the underlying function at the points in the vector \code{xi}. Methods can be: \tabular{ll}{ \code{linear} \tab linear interpolation (default) \cr \code{constant} \tab constant between points \cr \code{nearest} \tab nearest neighbor interpolation \cr \code{spline} \tab cubic spline interpolation \cr \code{cubic} \tab cubic Hermite interpolation \cr } } \value{ Numeric vector representing values at points \code{xi}. } \note{ Method `spline' uses the spline approach by Moler et al., and is identical with the Matlab option of the same name, but slightly different from R's spline function. The Matlab option ``cubic'' seems to have no direct correspondence in R. Therefore, we simply use \code{pchip} here. } \seealso{ \code{\link{approx}}, \code{\link{spline}} } \examples{ x <- c(0.8, 0.3, 0.1, 0.6, 0.9, 0.5, 0.2, 0.0, 0.7, 1.0, 0.4) y <- x^2 xi <- seq(0, 1, len = 81) yl <- interp1(x, y, xi, method = "linear") yn <- interp1(x, y, xi, method = "nearest") ys <- interp1(x, y, xi, method = "spline") \dontrun{ plot(x, y); grid() lines(xi, yl, col="blue", lwd = 2) lines(xi, yn, col="black", lty = 2) lines(xi, ys, col="red") } ## Difference between spline (Matlab) and spline (R). x <- 1:6 y <- c(16, 18, 21, 17, 15, 12) xs <- linspace(1, 6, 51) ys <- interp1(x, y, xs, method = "spline") sp <- spline(x, y, n = 51, method = "fmm") \dontrun{ plot(x, y, main = "Matlab and R splines") grid() lines(xs, ys, col = "red") lines(sp$x, sp$y, col = "blue") legend(4, 20, c("Matlab spline", "R spline"), col = c("red", "blue"), lty = 1) } } \keyword{ math } pracma/man/diag.Rd0000644000176200001440000000164012001517660013462 0ustar liggesusers\name{Diag} \alias{Diag} \title{Matrix Diagonal} \description{ Generate diagonal matrices or return diagonal of a matrix } \usage{ Diag(x, k = 0) } \arguments{ \item{x}{vector or matrix} \item{k}{integer indicating a secondary diagonal} } \details{ If \code{x} is a vector, \code{Diag(x, k)} generates a matrix with \code{x} as the (k-th secondary) diagonal. If \code{x} is a matrix, \code{Diag(x, k)} returns the (\code{k}-th secondary) diagonal of \code{x}. The \code{k}-th secondary diagonal is above the main diagonal for \code{k > 0} and below the main diagonal for \code{k < 0}. } \value{ matrix or vector } \note{ In Matlab/Octave this function is called \code{diag()} and has a different signature than the corresponding function in \R. } \seealso{ \code{\link{diag}}, \code{\link{Trace}} } \examples{ Diag(matrix(1:12,3,4), 1) Diag(matrix(1:12,3,4), -1) Diag(c(1,5,9), 1) Diag(c(1,5,9), -1) } \keyword{ array } pracma/man/sortrows.Rd0000644000176200001440000000105712062032441014456 0ustar liggesusers\name{sortrows} \alias{sortrows} \title{Sort Rows of a Matrix (Matlab Style)} \description{ Sort rows of a matrix according to values in a column. } \usage{ sortrows(A, k = 1) } \arguments{ \item{A}{numeric matrix.} \item{k}{number of column to sort the matrix accordingly.} } \details{ \code{sortrows(A, k)} sorts the rows of the matrix \code{A} such that column \code{k} is increasingly sorted. } \value{ Returns the sorted matrix. } \seealso{ \code{\link{sort}} } \examples{ A <- magic(5) sortrows(A) sortrows(A, k = 2) } \keyword{array} pracma/man/polar.Rd0000644000176200001440000000244112042212424013666 0ustar liggesusers\name{polar} \alias{polar} \title{ Polar Coordinate Plot (Matlab Style) } \description{ The polar function accepts polar coordinates, plots them in a Cartesian plane, and draws the polar grid on the plane. } \usage{ polar(t, r, type="l", col = "blue", grcol = "darkgrey", bxcol = "black", main = "Polar Plot", add = FALSE, ...) } \arguments{ \item{t, r}{vectors specifying angle and radius.} \item{type}{type of the plot, lines, points, or no plotting.} \item{col}{color of the graph.} \item{grcol, bxcol}{color of grid anf box around the plot.} \item{main}{plot title.} \item{add}{logical; if true, the graph will be plotted into the coordinate system of an existing plot.} \item{...}{plotting parameters to be passed to the \code{points} function.} } \details{ \code{polar(theta,rho)} creates a polar coordinate plot of the angle \code{theta} versus the radius \code{rho}. \code{theta} is the angle from the x-axis to the radius vector specified in radians; \code{rho} is the length of the radius vector. } \value{ Generates a plot; no returns. } \examples{ \dontrun{ t <- deg2rad(seq(0, 360, by = 2)) polar(t, cos(2*t), bxcol = "white", main = "Sine and Cosine") polar(t, sin(2*t), col = "red", add = TRUE) } } \keyword{ graphs } pracma/man/line_integral.Rd0000644000176200001440000000311612425377750015410 0ustar liggesusers\name{line_integral} \alias{line_integral} \title{ Line integral (in the complex plane) } \description{ Provides complex line integrals. } \usage{ line_integral(fun, waypoints, method = NULL, reltol = 1e-8, ...) } \arguments{ \item{fun}{integrand, complex (vectorized) function.} \item{method}{integration procedure, see below.} \item{waypoints}{complex integration: points on the integration curve.} \item{reltol}{relative tolerance.} \item{...}{additional parameters to be passed to the function.} } \details{ \code{line_integral} realizes complex line integration, in this case straight lines between the waypoints. By passing discrete points densely along the curve, arbitrary line integrals can be approximated. \code{line_integral} will accept the same methods as \code{integral}; default is \code{integrate} from Base R. } \value{ Returns the integral, no error terms given. } \seealso{ \code{\link{integral}} } \examples{ ## Complex integration examples points <- c(0, 1+1i, 1-1i, 0) # direction mathematically negative f <- function(z) 1 / (2*z -1) I <- line_integral(f, points) abs(I - (0-pi*1i)) # 0 ; residuum 2 pi 1i * 1/2 f <- function(z) 1/z points <- c(-1i, 1, 1i, -1, -1i) I <- line_integral(f, points) # along a rectangle around 0+0i abs(I - 2*pi*1i) #=> 0 ; residuum: 2 pi i * 1 N <- 100 x <- linspace(0, 2*pi, N) y <- cos(x) + sin(x)*1i J <- line_integral(f, waypoints = y) # along a circle around 0+0i abs(I - J) #=> 5.015201e-17; same residuum } \keyword{ math } pracma/man/numderiv.Rd0000644000176200001440000000427512274047002014416 0ustar liggesusers\name{numderiv} \alias{numderiv} \alias{numdiff} \title{ Richardson's Numerical Derivative } \description{ Richardson's method applied to the computation of the numerical derivative. } \usage{ numderiv(f, x0, maxiter = 16, h = 1/2, ..., tol = .Machine$double.eps) numdiff(f, x, maxiter = 16, h = 1/2, ..., tol = .Machine$double.eps) } \arguments{ \item{f}{function to be differentiated.} \item{x0, x}{point(s) at which the derivative is to be computed.} \item{maxiter}{maximum number of iterations.} \item{h}{starting step size, should be the default \code{h=0.5}.} \item{tol}{relative tolerance.} \item{...}{variables to be passed to function \code{f}.} } \details{ \code{numderiv} returns the derivative of \code{f} at \code{x0}, where \code{x0} must be a single scalar in the domain of the function. \code{numdiff} is a vectorized form of \code{numderiv} such that the derivatives will be returned at all points of the vector \code{x}. } \value{ Numeric scalar or vector of approximated derivatives. } \references{ Mathews, J. H., and K. D. Fink (1999). Numerical Methods Using Matlab. Third Edition, Prentice Hall. } \note{ See \code{grad} in the `numDeriv' package for another implementation of Richardson's method in the context of numerical differentiation. } \seealso{ \code{\link{fderiv}}, \code{\link{complexstep}} } \examples{ # Differentiate an anti-derivative function f <- function(x) sin(x)*sqrt(1+sin(x)) F <- function(x) integrate(f, 0, x, rel.tol = 1e-12)$value x0 <- 1 dF0 <- numderiv(F, x0, tol = 6.5e-15) #=> 1.141882942715462 f(x0) # 1.141882942715464 true value # fderiv(F, x0) # 1.141882942704476 # numDeriv::grad(F, x0) # 1.141882942705797 # Compare over a whole period x <- seq(0, 2*pi, length.out = 11) max(abs(numdiff(sin, x) - cos(x))) #=> 3.44e-15 # max(abs(numDeriv::grad(sin, x) - cos(x))) # 7.70e-12 # Example from complex step f <- function(x) exp(x) / sqrt(sin(x)^3 + cos(x)^3) x0 <- 1.5 numderiv(f, x0) # 4.05342789389876, error 0.5e-12 # 4.053427893898621... true value } \keyword{ math } pracma/man/bits.Rd0000644000176200001440000000177512367744414013546 0ustar liggesusers\name{bits} \alias{bits} \title{Binary Representation} \description{ Literal bit representation. } \usage{ bits(x, k = 54, pos_sign = FALSE, break0 = FALSE) } \arguments{ \item{x}{a positive or negative floating point number.} \item{k}{number of binary digits after the decimal point} \item{pos_sign}{logical; shall the '+' sign be included.} \item{break0}{logical; shall trailing zeros be included.} } \details{ The literal bit/binary representation of a floating point number is computed by subtracting powers of 2. } \value{ Returns a string containing the binary representation. } \seealso{ \code{\link{nextpow2}} } \examples{ bits(2^10) # "10000000000" bits(1 + 2^-10) # "1.000000000100000000000000000000000000000000000000000000" bits(pi) # "11.001001000011111101101010100010001000010110100011000000" bits(1/3.0) # "0.010101010101010101010101010101010101010101010101010101" bits(1 + eps()) # "1.000000000000000000000000000000000000000000000000000100" } \keyword{ arith } pracma/man/crossn.Rd0000644000176200001440000000210412042212424014054 0ustar liggesusers\name{crossn} \alias{crossn} \title{n-dimensional Vector Cross Product} \description{ Vector cross product of \code{n-1} vectors in n-dimensional space } \usage{ crossn(A) } \arguments{ \item{A}{matrix of size \code{(n-1) x n} where \code{n >= 2}.} } \details{ The rows of the matrix \code{A} are taken as\code{(n-1)} vectors in \code{n}-dimensional space. The cross product generates a vector in this space that is orthogonal to all these rows in \code{A} and its length is the volume of the geometric hypercube spanned by the vectors. } \value{ a vector of length \code{n} } \note{ The `scalar triple product' in \eqn{R^3} can be defined as \code{spatproduct <- function(a, b, c) dot(a, crossn(b, c))} It represents the volume of the parallelepiped spanned by the three vectors. } \seealso{ \code{\link{cross}}, \code{\link{dot}} } \examples{ A <- matrix(c(1,0,0, 0,1,0), nrow=2, ncol=3, byrow=TRUE) crossn(A) #=> 0 0 1 x <- c(1.0, 0.0, 0.0) y <- c(1.0, 0.5, 0.0) z <- c(0.0, 0.0, 1.0) identical(dot(x, crossn(rbind(y, z))), det(rbind(x, y, z))) } \keyword{ array } pracma/man/peaks.Rd0000644000176200001440000000221111726441722013664 0ustar liggesusers\name{peaks} \alias{peaks} \title{ Peaks Function (Matlab Style) } \description{ An example functions in two variables, with peaks. } \usage{ peaks(v = 49, w) } \arguments{ \item{v}{vector, whose length will be used, or a natural number.} \item{w}{another vector, will be used in \code{meshgrid(x,y)}.} } \details{ \code{peaks} is a function of two variables, obtained by translating and scaling Gaussian distributions, which is useful for demonstrating three-dimensional plots. } \value{ Returns three matrices as a list with \code{X}, \code{Y}, and \code{Z} components, the first two being the result of the \code{meshgrid} function, and \code{Z} the application of the following function at the points of \code{X} and \code{Y}: \code{z <- 3 * (1-x)^2 * exp(-(x^2) - (y+1)^2) - 10 * (x/5 - x^3 - y^5) * exp(-x^2 - y^2) - 1/3 * exp(-(x+1)^2 - y^2)} } \note{ The variant that \code{peaks()} will display the 3-dim. graph as in Matlab is not yet implemented. } \seealso{ \code{\link{meshgrid}} } \examples{ peaks(3) \dontrun{ P <- peaks() x <- P$X[1,]; y <- P$Y[, 1] persp(x, y, P$Z) } } \keyword{ graphs } pracma/man/errorbar.Rd0000644000176200001440000000334512042212424014373 0ustar liggesusers\name{errorbar} \alias{errorbar} \title{ Plot Error Bars } \description{ Draws symmetric error bars in x- and/or y-direction. } \usage{ errorbar(x, y, xerr = NULL, yerr = NULL, bar.col = "red", bar.len = 0.01, grid = TRUE, with = TRUE, add = FALSE, ...) } \arguments{ \item{x, y}{x-, y-coordinates} \item{xerr, yerr}{length of the error bars, relative to the x-, y-values.} \item{bar.col}{color of the error bars; default: red} \item{bar.len}{length of the cross bars orthogonal to the error bars; default: 0.01.} \item{grid}{logical; should the grid be plotted?; default: true} \item{with}{logical; whether to end the error bars with small cross bars.} \item{add}{logical; should the error bars be added to an existing plot?; default: false.} \item{...}{additional plotting parameters that will be passed to the \code{plot} function.} } \details{ \code{errorbar} plots \code{y} versus \code{x} with symmetric error bars, with a length determined by \code{xerr} resp. \code{yerr} in x- and/or y-direction. If \code{xerr} or \code{yerr} is \code{NULL} error bars in this direction will not be drawn. A future version will allow to draw unsymmetric error bars by specifying upper and lower limits when \code{xerr} or \code{yerr} is a matrix of size \code{(2 x length(x))}. } \value{ Generates a plot, no return value. } \seealso{ \code{plotrix::plotCI}, \code{Hmisc::errbar} } \examples{ \dontrun{ x <- seq(0, 2*pi, length.out = 20) y <- sin(x) xe <- 0.1 ye <- 0.1 * y errorbar(x, y, xe, ye, type = "l", with = FALSE) cnt <- round(100*randn(20, 3)) y <- apply(cnt, 1, mean) e <- apply(cnt, 1, sd) errorbar(1:20, y, yerr = e, bar.col = "blue") } } \keyword{ graphs } pracma/man/psi.Rd0000644000176200001440000000203712130550730013350 0ustar liggesusers\name{psi} \alias{psi} \title{ Psi (Polygamma) Function } \description{ Arbitrary order Polygamma function valid in the entire complex plane. } \usage{ psi(k, z) } \arguments{ \item{k}{order of the polygamma function, whole number greater or equal 0.} \item{z}{numeric complex number or vector.} } \details{ Computes the Polygamma function of arbitrary order, and valid in the entire complex plane. The polygamma function is defined as \deqn{\psi(n, z) = \frac{d^{n+1}}{dz^{n+1}} \log(\Gamma(z))} If \code{n} is 0 or absent then \code{psi} will be the Digamma function. If \code{n=1,2,3,4,5} etc. then \code{psi} will be the tri-, tetra-, penta-, hexa-, hepta- etc. gamma function. } \value{ Returns a complex number or a vector of complex numbers. } \examples{ psi(2) - psi(1) # 1 -psi(1) # Eulers constant: 0.57721566490153 [or, -psi(0, 1)] psi(1, 2) # pi^2/6 - 1 : 0.64493406684823 psi(10, -11.5-0.577007813568142i) # is near a root of the decagamma function } pracma/man/humps.Rd0000644000176200001440000000167513034767277013744 0ustar liggesusers\name{humps} \alias{humps} \alias{sinc} \alias{psinc} \title{ Matlab Test Functions } \description{ Matlab test functions. } \usage{ humps(x) sinc(x) psinc(x, n) } \arguments{ \item{x}{numeric scalar or vector.} \item{n}{positive integer.} } \details{ \code{humps} is a test function for finding zeros, for optimization and integration. Its root is at \code{x = 1.2995}, a (local) minimum at \code{x = 0.6370}, and the integral from \code{0.5} to \code{1.0} is \code{8.0715}. \code{sinc} is defined as \eqn{sinc(t) = \frac{\sin(\pi t)}{\pi t}}. It is the continuous inverse Fourier transform of the rectangular pulse of width \eqn{2\pi} and height \eqn{1}. \code{psinc} is the 'periodic sinc function' and is defined as \eqn{psinc(x,n) = \frac{\sin(x n/2)}{n \sin(x/2)}}. } \value{ Numeric scalar or vector. } \examples{ \dontrun{ plot(humps(), type="l"); grid() x <- seq(0, 10, length=101) plot(x, sinc(x), type="l"); grid() } } pracma/man/bsxfun.Rd0000644000176200001440000000260213231614333014063 0ustar liggesusers\name{bsxfun} \alias{bsxfun} \alias{arrayfun} \title{ Elementwise Function Application (Matlab Style) } \description{ Apply a binary function elementwise. } \usage{ bsxfun(func, x, y) arrayfun(func, ...) } \arguments{ \item{func}{function with two or more input parameters.} \item{x, y}{two vectors, matrices, or arrays of the same size.} \item{...}{list of arrays of the same size.} } \details{ \code{bsxfun} applies element-by-element a binary function to two vectors, matrices, or arrays of the same size. For matrices, \code{sweep} is used for reasons of speed, otherwise \code{mapply}. (For arrays of more than two dimensions this may become very slow.) \code{arrayfun} applies \code{func} to each element of the arrays and returns an array of the same size. } \value{ The result will be a vector or matrix of the same size as \code{x, y}. } \note{ The underlying function \code{mapply} can be applied in a more general setting with many function parameters: \code{mapply(f, x, y, z, ...)} but the array structure will not be preserved in this case. } \seealso{ \code{\link{Vectorize}} } \examples{ X <- matrix(rep(1:10, each = 10), 10, 10) Y <- t(X) bsxfun("*", X, Y) # multiplication table f <- function(x, y) x[1] * y[1] # function not vectorized A <- matrix(c(2, 3, 5, 7), 2, 2) B <- matrix(c(11, 13, 17, 19), 2, 2) arrayfun(f, A, B) } \keyword{ math } pracma/man/gcd.Rd0000644000176200001440000000221512031004636013307 0ustar liggesusers\name{gcd, lcm} \alias{gcd} \alias{Lcm} \title{GCD and LCM Integer Functions} \description{ Greatest common divisor and least common multiple } \usage{ gcd(a, b, extended = FALSE) Lcm(a, b) } \arguments{ \item{a, b}{vectors of integers.} \item{extended}{logical; if \code{TRUE} the extended Euclidean algorithm will be applied.} } \details{ Computation based on the extended Euclidean algorithm. If both \code{a} and \code{b} are vectors of the same length, the greatest common divisor/lowest common multiple will be computed elementwise. If one is a vektor, the other a scalar, the scalar will be replicated to the same length. } \value{ A numeric (integer) value or vector of integers. Or a list of three vectors named \code{c, d, g}, g containing the greatest common divisors, such that \code{g = c * a + d * b}. } \note{ The following relation is always true: \code{n * m = gcd(n, m) * lcm(n, m)} } \seealso{ \code{numbers::extGCD} } \examples{ gcd(12, 1:24) gcd(46368, 75025) # Fibonacci numbers are relatively prime to each other Lcm(12, 1:24) Lcm(46368, 75025) # = 46368 * 75025 } \keyword{ arith } pracma/man/eta.Rd0000644000176200001440000000157412465405723013347 0ustar liggesusers\name{eta} \alias{eta} \title{ Dirichlet Eta Function } \description{ Dirichlet's eta function valid in the entire complex plane. } \usage{ eta(z) } \arguments{ \item{z}{Real or complex number or a numeric or complex vector.} } \details{ Computes the eta function for complex arguments using a series expansion. Accuracy is about 13 significant digits for \code{abs(z)<100}, drops off with higher absolute values. } \value{ Returns a complex vector of function values. } \references{ Zhang, Sh., and J. Jin (1996). Computation of Special Functions. Wiley-Interscience, New York. } \note{ Copyright (c) 2001 Paul Godfrey for a Matlab version available on Mathwork's Matlab Central under BSD license. } \seealso{ \code{\link{gammaz}}, \code{\link{zeta}} } \examples{ z <- 0.5 + (1:5)*1i eta(z) z <- c(0, 0.5+1i, 1, 1i, 2+2i, -1, -2, -1-1i) eta(z) } \keyword{ specfun } pracma/man/clenshaw_curtis.Rd0000644000176200001440000000216412465405723015767 0ustar liggesusers\name{clenshaw_curtis} \alias{clenshaw_curtis} \title{ Clenshaw-Curtis Quadrature Formula } \description{ Clenshaw-Curtis Quadrature Formula } \usage{ clenshaw_curtis(f, a = -1, b = 1, n = 1024, ...) } \arguments{ \item{f}{function, the integrand, without singularities.} \item{a, b}{lower and upper limit of the integral; must be finite.} \item{n}{Number of Chebyshev nodes to account for.} \item{\ldots}{Additional parameters to be passed to the function} } \details{ Clenshaw-Curtis quadrature is based on sampling the integrand on Chebyshev points, an operation that can be implemented using the Fast Fourier Transform. } \value{ Numerical scalar, the value of the integral. } \references{ Trefethen, L. N. (2008). Is Gauss Quadrature Better Than Clenshaw-Curtis? SIAM Review, Vol. 50, No. 1, pp 67--87. } \seealso{ \code{\link{gaussLegendre}}, \code{\link{gauss_kronrod}} } \examples{ ## Quadrature with Chebyshev nodes and weights f <- function(x) sin(x+cos(10*exp(x))/3) \dontrun{ezplot(f, -1, 1, fill = TRUE)} cc <- clenshaw_curtis(f, n = 64) #=> 0.0325036517151 , true error > 1.3e-10 } \keyword{ math } pracma/man/rand.Rd0000644000176200001440000000551513575173100013513 0ustar liggesusers\name{rand} \alias{rand} \alias{randn} \alias{randi} \alias{randsample} \alias{rands} \alias{randp} \title{Create Random Matrices} \description{ Create random matrices or random points in a unit circle (Matlab style). } \usage{ rand(n = 1, m = n) randn(n = 1, m = n) randi(imax, n = 1, m = n) randsample(n, k, w = NULL, replacement = FALSE) rands(n = 1, N = 1, r = 1) randp(n = 1, r = 1) } \arguments{ \item{n, m}{integers specifying the size of the matrix} \item{imax}{integer or pair of integers} \item{k}{number of elements to return.} \item{w}{weight vector, used for discrete probabilities.} \item{replacement}{logical; sampling with or without replacement.} \item{N}{dimension of a shere, N=1 for the unit circle} \item{r}{radius of circle, default 1.} } \details{ \code{rand()}, \code{randn()}, \code{randi()} create random matrices of size \code{n x m}, where the default is square matrices if \code{m} is missing. \code{rand()} uses the uniform distribution on \code{]0, 1[}, while \code{randn()} uses the normal distribution with mean 0 and standard deviation 1. \code{randi()} generates integers between \code{imax[1]} and \code{imax[2]} resp. 1 and \code{imax}, if \code{imax} is a scalar. \code{randsample()} samples \code{k} elements from \code{1:n}, with or without replacement, or returns a weighted sample (with replacement), using the weight vector \code{w} for probabilities. \code{rands()} generates uniformly random points on an \code{N}-sphere in the \code{N+1}-dimensional space. To generate uniformly random points in the \code{N}-dim. unit cube, take points in \code{S^{N-1}} und multiply with \code{unif(n)^(1/(N-1))}. \code{randp()} generates uniformly random points in the unit circle (or in a circle of radius r). } \value{ Matrices of size \code{nxm} resp. a vector of length \code{n}. \code{randp()} returns a pair of values representing a point in the circle, or a matrix of size \code{(n,2)}. \code{rands()} returns a matrix of size \code{(n, N+1)} with all rows being vectors of length \code{1}. } \note{ The Matlab style of setting a seed is not available; use R style \code{set.seed(...)}. } \references{ Knuth, D. (1981). The Art of Computer programming; Vol. 2: Seminumerical Algorithms; Chapt. 3: Random Numbers. Addison-Wesley, Reading. } \seealso{ \code{\link{set.seed}} } \examples{ rand(3) randn(1, 5) randi(c(1,6), 1, 10) randsample(10, 5, replacement = TRUE, w = c(0,0,0, 1, 1, 1, 1, 0,0,0)) P <- rands(1000, N = 1, r = 2) U <- randp(1000, 2) \dontrun{ plot(U[, 1], U[, 2], pch = "+", asp = 1) points(P, pch = ".")} #-- v is 2 independent normally distributed elements # u <- randp(1); r <- t(u) %*% u # v <- sqrt(-2 * log(r)/r) * u n <- 5000; U <- randp(n) R <- apply(U*U, 1, sum) P <- sqrt(-2 * log(R)/R) * U # rnorm(2*n) \dontrun{ hist(c(P))} } \keyword{ stat } pracma/man/brentdekker.Rd0000644000176200001440000000307713342034603015064 0ustar liggesusers\name{brentDekker} \alias{brentDekker} \alias{brent} \title{ Brent-Dekker Root Finding Algorithm } \description{ Find root of continuous function of one variable. } \usage{ brentDekker(fun, a, b, maxiter = 500, tol = 1e-12, ...) brent(fun, a, b, maxiter = 500, tol = 1e-12, ...) } \arguments{ \item{fun}{function whose root is to be found.} \item{a, b}{left and right end points of an interval; function values need to be of different sign at the endpoints.} \item{maxiter}{maximum number of iterations.} \item{tol}{relative tolerance.} \item{...}{additional arguments to be passed to the function.} } \details{ \code{brentDekker} implements a version of the Brent-Dekker algorithm, a well known root finding algorithms for real, univariate, continuous functions. The Brent-Dekker approach is a clever combination of secant and bisection with quadratic interpolation. \code{brent} is simply an alias for \code{brentDekker}. } \value{ \code{brent} returns a list with \item{root}{location of the root.} \item{f.root}{funtion value at the root.} \item{f.calls}{number of function calls.} \item{estim.prec}{estimated relative precision.} } \references{ Quarteroni, A., R. Sacco, and F. Saleri (2007). Numerical Mathematics. Second Edition, Springer-Verlag, Berlin Heidelberg. } \seealso{ \code{\link{ridders}}, \code{\link{newtonRaphson}} } \examples{ # Legendre polynomial of degree 5 lp5 <- c(63, 0, -70, 0, 15, 0)/8 f <- function(x) polyval(lp5, x) brent(f, 0.6, 1) # 0.9061798459 correct to 12 places } \keyword{ math } pracma/man/neville.Rd0000644000176200001440000000145712042212424014215 0ustar liggesusers\name{neville} \alias{neville} \title{ Neville's Method } \description{ Neville's's method of polynomial interpolation. } \usage{ neville(x, y, xs) } \arguments{ \item{x, y}{x-, y-coordinates of data points defining the polynomial.} \item{xs}{single point to be interpolated.} } \details{ Straightforward implementation of Neville's method; not yet vectorized. } \value{ Interpolated value at \code{xs} of the polynomial defined by \code{x,y}. } \references{ Each textbook on numerical analysis. } \seealso{ \code{\link{newtonInterp}}, \code{\link{barylag}} } \examples{ p <- Poly(c(1, 2, 3)) fp <- function(x) polyval(p, x) x <- 0:4; y <- fp(x) xx <- linspace(0, 4, 51) yy <- numeric(51) for (i in 1:51) yy[i] <- neville(x, y, xx[i]) \dontrun{ ezplot(fp, 0, 4) points(xx, yy)} } \keyword{ math } pracma/man/horner.Rd0000644000176200001440000000362412042212424014052 0ustar liggesusers\name{horner} \alias{horner} \alias{hornerdefl} \title{ Horner's Rule } \description{ Compute the value of a polynomial via Horner's Rule. } \usage{ horner(p, x) hornerdefl(p, x) } \arguments{ \item{p}{Numeric vector representing a polynomial.} \item{x}{Numeric scalar, vector or matrix at which to evaluate the polynomial.} } \details{ \code{horner} utilizes the Horner scheme to evaluate the polynomial and its first derivative at the same time. The polynomial \code{p = p_1*x^n + p_2*x^{n-1} + ... + p_n*x + p_{n+1}} is hereby represented by the vector \code{p_1, p_2, ..., p_n, p_{n+1}}, i.e. from highest to lowest coefficient. \code{hornerdefl} uses a similar approach to return the value of \code{p} at \code{x} and a polynomial \code{q} that satisfies \code{p(t) = q(t) * (t - x) + r, r constant} which implies \code{r=0} if \code{x} is a root of \code{p}. This will allow for a repeated root finding of polynomials. } \value{ \code{horner} returns a list with two elements, \code{list(y=..., dy=...)} where the first list elements returns the values of the polynomial, the second the values of its derivative at the point(s) \code{x}. \code{hornerdefl} returns a list \code{list(y=..., dy=...)} where \code{q} represents a polynomial, see above. } \note{ For fast evaluation, there is no error checking for \code{p} and \code{x}, which both must be numerical vectors (\code{x} can be a matrix in \code{horner}). } \references{ Quarteroni, A., and Saleri, F. (2006) Scientific Computing with Matlab and Octave. Second Edition, Springer-Verlag, Berlin Heidelberg. } \seealso{ \code{\link{polyval}} } \examples{ x <- c(-2, -1, 0, 1, 2) p <- c(1, 0, 1) # polynomial x^2 + x, derivative 2*x horner(p, x)$y #=> 5 2 1 2 5 horner(p, x)$dy #=> -4 -2 0 2 4 p <- Poly(c(1, 2, 3)) # roots 1, 2, 3 hornerdefl(p, 3) # q = x^2- 3 x + 2 with roots 1, 2 } \keyword{ math } pracma/man/cranknic.Rd0000644000176200001440000000514112031327377014355 0ustar liggesusers\name{cranknic} \alias{cranknic} \title{ Crank-Nicolson Method } \description{ The Crank-Nicolson method for solving ordinary differential equations is a combination of the generic steps of the forward and backward Euler methods. } \usage{ cranknic(f, t0, t1, y0, ..., N = 100) } \arguments{ \item{f}{function in the differential equation \eqn{y' = f(x, y)};\cr defined as a function \eqn{R \times R^m \rightarrow R^m}, where \eqn{m} is the number of equations.} \item{t0, t1}{start and end points of the interval.} \item{y0}{starting values as row or column vector; for \eqn{m} equations \code{y0} needs to be a vector of length \code{m}.} \item{N}{number of steps.} \item{...}{Additional parameters to be passed to the function.} } \details{ Adding together forward and backword Euler method in the \code{cranknic} method is by finding the root of the function merging these two formulas. No attempt is made to catch any errors in the root finding functions. } \value{ List with components \code{t} for grid (or `time') points between \code{t0} and \code{t1}, and \code{y} an n-by-m matrix with solution variables in columns, i.e. each row contains one time stamp. } \references{ Quarteroni, A., and F. Saleri (2006). Scientific Computing With MATLAB and Octave. Second Edition, Springer-Verlag, Berlin Heidelberg. } \note{ This is for demonstration purposes only; for real problems or applications please use \code{ode23} or \code{rkf54}. } \seealso{ \code{\link{ode23}}, \code{\link{newmark}} } \examples{ ## Newton's example f <- function(x, y) 1 - 3*x + y + x^2 + x*y sol100 <- cranknic(f, 0, 1, 0, N = 100) sol1000 <- cranknic(f, 0, 1, 0, N = 1000) \dontrun{ # Euler's forward approach feuler <- function(f, t0, t1, y0, n) { h <- (t1 - t0)/n; x <- seq(t0, t1, by = h) y <- numeric(n+1); y[1] <- y0 for (i in 1:n) y[i+1] <- y[i] + h * f(x[i], y[i]) return(list(x = x, y = y)) } solode <- ode23(f, 0, 1, 0) soleul <- feuler(f, 0, 1, 0, 100) plot(soleul$x, soleul$y, type = "l", col = "blue", xlab = "", ylab = "", main = "Newton's example") lines(solode$t, solode$y, col = "gray", lwd = 3) lines(sol100$t, sol100$y, col = "red") lines(sol1000$t, sol1000$y, col = "green") grid() ## System of differential equations # "Herr und Hund" fhh <- function(x, y) { y1 <- y[1]; y2 <- y[2] s <- sqrt(y1^2 + y2^2) dy1 <- 0.5 - 0.5*y1/s dy2 <- -0.5*y2/s return(c(dy1, dy2)) } sol <- cranknic(fhh, 0, 60, c(0, 10)) plot(sol$y[, 1], sol$y[, 2], type = "l", col = "blue", xlab = "", ylab = "", main = '"Herr und Hund"') grid()} } \keyword{ ode } pracma/man/cart2sph.Rd0000644000176200001440000000435612042212424014306 0ustar liggesusers\name{cart2sph} \alias{cart2sph} \alias{sph2cart} \alias{cart2pol} \alias{pol2cart} \title{ Coordinate Transformations } \description{ Transforms between cartesian, spherical, polar, and cylindrical coordinate systems in two and three dimensions. } \usage{ cart2sph(xyz) sph2cart(tpr) cart2pol(xyz) pol2cart(prz) } \arguments{ \item{xyz}{cartesian coordinates x, y, z as vector or matrix.} \item{tpr}{spherical coordinates theta, phi, and r as vector or matrix.} \item{prz}{polar coordinates phi, r or cylindrical coordinates phi, r, z as vector or matrix.} } \details{ \code{cart2sph} returns spherical coordinates as (theta, phi, r), and \code{sph2cart} expects them in this sequence. \code{cart2pol} returns polar coordinates (phi, r) if \code{length(xyz)==2} and cylindrical coordinates (phi, r, z) else. \code{pol2cart} needs them in this sequence and length. To go from cylindrical to cartesian coordinates, transform to cartesian coordinates first --- or write your own function, see the examples. All transformation functions are vectorized. } \value{ All functions return a (2- or 3-dimensional) vector representing a point in the requested coordinate system, or a matrix with 2 or 3 named columns where is row represents a point. The columns are named accordingly. } \note{ In Matlab these functions accept two or three variables and return two or three values. In R it did not appear appropriate to return coordinates as a list. These functions should be vectorized in the sense that they accept will accept matrices with number of rows or columns equal to 2 or 3. } \examples{ x <- 0.5*cos(pi/6); y <- 0.5*sin(pi/6); z <- sqrt(1 - x^2 - y^2) (s <-cart2sph(c(x, y, z))) # 0.5235988 1.0471976 1.0000000 sph2cart(s) # 0.4330127 0.2500000 0.8660254 cart2pol(c(1,1)) # 0.7853982 1.4142136 cart2pol(c(1,1,0)) # 0.7853982 1.4142136 0.0000000 pol2cart(c(pi/2, 1)) # 6.123234e-17 1.000000e+00 pol2cart(c(pi/4, 1, 1)) # 0.7071068 0.7071068 1.0000000 ## Transform spherical to cylindrical coordinates and vice versa sph2cyl <- function(th.ph.r) cart2pol(sph2cart(th.ph.r)) cyl2sph <- function(phi.r.z) cart2sph(pol2cart(phi.r.z)) } \keyword{ math } pracma/man/linprog.Rd0000644000176200001440000001056212114645076014243 0ustar liggesusers\name{linprog} \alias{linprog} \title{ Linear Programming Solver } \description{ Solves simple linear programming problems, allowing for inequality and equality constraints as well as lower and upper bounds. } \usage{ linprog(cc, A = NULL, b = NULL, Aeq = NULL, beq = NULL, lb = NULL, ub = NULL, x0 = NULL, I0 = NULL, bigM = 100, maxiter = 20, maximize = FALSE) } \arguments{ \item{cc}{defines the linear objective function.} \item{A}{matrix representing the inequality constraints \code{A x <= b}.} \item{b}{vector, right hand side of the inequalities.} \item{Aeq}{matrix representing the equality constraints \code{Aeq x <= beq}.} \item{beq}{vector, right hand side of the inequalities.} \item{lb}{lower bounds, if not \code{NULL} must all be greater or equal 0.} \item{ub}{upper bounds, if not \code{NULL} must all be greater or equal \code{lb}.} \item{x0}{feasible base vector, will not be used at the moment.} \item{I0}{index set of \code{x0}, will not be used at the moment.} \item{bigM}{big-M constant, will be used for finding a base vector.} \item{maxiter}{maximum number of iterations.} \item{maximize}{logical; shall the objective be minimized or maximized?} } \details{ Solves linear programming problems of the form \eqn{min cc' * x} such that \deqn{A * x \le b} \deqn{A_{eq} * x = b_{eq}} \deqn{lb \le x \le ub} } \value{ List with \itemize{ \item{\code{x}} the solution vector. \item{\code{fval}} the value at the optimal solution. \item{\code{errno}, \code{mesage}} the error number and message. } } \references{ Vanderbei, R. J. (2001). Linear Programming: Foundations and Extensions. Princeton University Press. Eiselt, H. A., and C.-L. Sandblom (2012). Operations Research: A Model-based Approach. Springer-Verlag, Berlin Heidelberg. } \author{ HwB } \note{ This is a first version that will be unstable at times. For real linear programming problems use package \code{lpSolve}. } \seealso{ \code{linprog::solveLP}, \code{lpSolve::lp} } \examples{ ## Examples from the book "Operations research - A Model-based Approach" #-- production planning cc <- c(5, 3.5, 4.5) Ain <- matrix(c(3, 5, 4, 6, 1, 3), 2, 3, byrow=TRUE) bin <- c(540, 480) linprog(cc, A = Ain, b = bin, maximize = TRUE) # $x 20 0 120 # $fval 640 #-- diet problem cc <- c(1.59, 2.19, 2.99) Ain <- matrix(c(-250, -380, -257, 250, 380, 257, 13, 31, 28), 3, 3, byrow = TRUE) bin <- c(-1800, 2200, 100) linprog(cc, A = Ain, b = bin) #-- employee scheduling cc <- c(1, 1, 1, 1, 1, 1) A <- (-1)*matrix(c(1, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 1), 6, 6, byrow = TRUE) b <- -c(17, 9, 19, 12, 5, 8) linprog(cc, A, b) #-- inventory models cc <- c(1, 1.1, 1.2, 1.25, 0.05, 0.15, 0.15) Aeq <- matrix(c(1, 0, 0, 0, -1, 0, 0, 0, 1, 0, 0, 1, -1, 0, 0, 0, 1, 0, 0, 1, -1, 0, 0, 0, 1, 0, 0, 1), 4, 7, byrow = TRUE) beq <- c(60, 70, 130, 150) ub <- c(120, 140, 150, 140, Inf, Inf, Inf) linprog(cc, Aeq = Aeq, beq = beq, ub = ub) #-- allocation problem cc <- c(1, 1, 1, 1, 1) A <- matrix(c(-5, 0, 0, 0, 0, 0, -4.5, 0, 0, 0, 0, 0, -5.5, 0, 0, 0, 0, 0, -3.5, 0, 0, 0, 0, 0, -5.5, 5, 0, 0, 0, 0, 0, 4.5, 0, 0, 0, 0, 0, 5.5, 0, 0, 0, 0, 0, 3.5, 0, 0, 0, 0, 0, 5.5, -5, -4.5, -5.5, -3.5, -5.5, 10, 10.0, 10.0, 10.0, 10.0, 0.2, 0.2, 0.2, -1.0, 0.2), 13, 5, byrow = TRUE) b <- c(-50, -55, -60, -50, -50, rep(100, 5), -5*64, 700, 0) # linprog(cc, A = A, b = b) lb <- b[1:5] / diag(A[1:5, ]) ub <- b[6:10] / diag(A[6:10, ]) A1 <- A[11:13, ] b1 <- b[11:13] linprog(cc, A1, b1, lb = lb, ub = ub) #-- transportation problem cc <- c(1, 7, 4, 2, 3, 5) Aeq <- matrix(c(1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1), 5, 6, byrow = TRUE) beq <- c(30, 20, 15, 25, 10) linprog(cc, Aeq = Aeq, beq = beq) } \keyword{ optimize } pracma/man/inv.Rd0000644000176200001440000000134611652316301013355 0ustar liggesusers\name{inv} \alias{inv} \title{Matrix Inverse (Matlab Style)} \description{ Invert a numeric or complex matrix. } \usage{ inv(a) } \arguments{ \item{a}{real or complex square matrix} } \details{ Computes the matrix inverse by calling \code{solve(a)} and catching the error if the matrix is nearly singular. } \value{ square matrix that is the inverse of \code{a}. } \note{ \code{inv()} is the function name used in Matlab/Octave. } \seealso{ \code{\link{solve}} } \examples{ A <- hilb(6) B <- inv(A) B # Compute the inverse matrix through Cramer's rule: n <- nrow(A) detA <- det(A) b <- matrix(NA, nrow = n, ncol = n) for (i in 1:n) { for (j in 1:n) { b[i, j] <- (-1)^(i+j) * det(A[-j, -i]) / detA } } b } \keyword{ array } pracma/man/polyder.Rd0000644000176200001440000000125311540452742014242 0ustar liggesusers\name{polyder} \alias{polyder} \title{Derivative of Polynomial} \description{ Differentiate polynomials. } \usage{ polyder(p, q) } \arguments{ \item{p}{polynomial \code{p} given as a vector} \item{q}{polynomial \code{p} given as a vector} } \details{ Calculates the derivative of polynomials and polynomial products. \code{polyder(p)} returns the derivative of \code{p} while \code{polyder(p, q)} returns the derivative of the product of the polynomials \code{p} and \code{q}. } \value{ a vector representing a polynomial } \seealso{ \code{\link{polyval}}, \code{\link{polyint}} } \examples{ polyder(c(3, 6, 9), c(1, 2, 0)) # 12 36 42 18 } \keyword{ math } pracma/man/fsolve.Rd0000644000176200001440000000322013452637217014064 0ustar liggesusers\name{fsolve} \alias{fsolve} \title{ Solve System of Nonlinear Equations } \description{ Solve a system of \code{m} nonlinear equations of \code{n} variables. } \usage{ fsolve(f, x0, J = NULL, maxiter = 100, tol = .Machine$double.eps^(0.5), ...) } \arguments{ \item{f}{function describing the system of equations.} \item{x0}{point near to the root.} \item{J}{Jacobian function of \code{f}, or \code{NULL}.} \item{maxiter}{maximum number of iterations in \code{gaussNewton}.} \item{tol}{tolerance to be used in Gauss-Newton.} \item{...}{additional variables to be passed to the function.} } \details{ \code{fsolve} tries to solve the components of function \code{f} simultaneously and uses the Gauss-Newton method with numerical gradient and Jacobian. If \code{m = n}, it uses \code{broyden}. Not applicable for univariate root finding. } \value{ List with \item{x}{location of the solution.} \item{fval}{function value at the solution.} } \references{ Antoniou, A., and W.-S. Lu (2007). Practical Optimization: Algorithms and Engineering Applications. Springer Science+Business Media, New York. } \note{ \code{fsolve} mimics the Matlab function of the same name. } \seealso{ \code{\link{broyden}}, \code{\link{gaussNewton}} } \examples{ \dontrun{ # Find a matrix X such that X * X * X = [1, 2; 3, 4] F <- function(x) { a <- matrix(c(1, 3, 2, 4), nrow = 2, ncol = 2, byrow = TRUE) X <- matrix(x, nrow = 2, ncol = 2, byrow = TRUE) return(c(X \%*\% X \%*\% X - a)) } x0 <- matrix(1, 2, 2) X <- matrix(fsolve(F, x0)$x, 2, 2) X # -0.1291489 0.8602157 # 1.2903236 1.1611747 } } \keyword{ optimize } pracma/man/gauss_kronrod.Rd0000644000176200001440000000207612042212424015435 0ustar liggesusers\name{gauss_kronrod} \alias{gauss_kronrod} \title{ Gauss-Kronrod Quadrature } \description{ Simple Gaussian-Kronrod quadrature formula. } \usage{ gauss_kronrod(f, a, b, ...) } \arguments{ \item{f}{function to be integrated.} \item{a, b}{end points of the interval.} \item{...}{variables to be passed to the function.} } \details{ Gaussian quadrature of degree 7 with Gauss-Kronrod of degree 15 for error estimation, the \code{quadQK15} procedure in the QUADPACK library. } \value{ List of value and relative error. } \references{ Fausett, L. V. (2007). Applied Numerical Analysis Using Matlab. Second edition, Prentice Hall. } \note{ The function needs to be vectorized (though this could easily be changed), but the function does not need to be defined at the end points. } \seealso{ \code{\link{quadgk}}, \code{\link{romberg}} } \examples{ gauss_kronrod(sin, 0, pi) # 2.000000000000000 , rel.error: 1.14e-12 gauss_kronrod(exp, 0, 1) # 1.718281828459045 , rel.error: 0 # 1.718281828459045 , i.e. exp(1) - 1 } \keyword{ math } pracma/man/gaussLaguerre.Rd0000644000176200001440000000342613024246505015376 0ustar liggesusers\name{gaussLaguerre} \alias{gaussLaguerre} \title{ Gauss-Laguerre Quadrature Formula } \description{ Nodes and weights for the n-point Gauss-Laguerre quadrature formula. } \usage{ gaussLaguerre(n, a = 0) } \arguments{ \item{n}{Number of nodes in the interval \code{[0, Inf[}.} \item{a}{exponent of \code{x} in the integrand: must be greater or equal to 0, otherwise the integral would not converge.} } \details{ Gauss-Laguerre quadrature is used for integrating functions of the form \deqn{\int_0^{\infty} f(x) x^a e^{-x} dx} over the infinite interval \eqn{]0, \infty[}. \code{x} and \code{w} are obtained from a tridiagonal eigenvalue problem. The value of such an integral is then \code{sum(w*f(x))}. } \value{ List with components \code{x}, the nodes or points in\code{[0, Inf[}, and \code{w}, the weights applied at these nodes. } \references{ Gautschi, W. (2004). Orthogonal Polynomials: Computation and Approximation. Oxford University Press. Trefethen, L. N. (2000). Spectral Methods in Matlab. SIAM, Society for Industrial and Applied Mathematics. } \note{ The basic quadrature rules are well known and can, e. g., be found in Gautschi (2004) --- and explicit Matlab realizations in Trefethen (2000). These procedures have also been implemented in Matlab by Geert Van Damme, see his entries at MatlabCentral since 2010. } \seealso{ \code{\link{gaussLegendre}}, \code{\link{gaussHermite}} } \examples{ cc <- gaussLaguerre(7) # integrate exp(-x) from 0 to Inf sum(cc$w) # 1 # integrate x^2 * exp(-x) # integral x^n * exp(-x) is n! sum(cc$w * cc$x^2) # 2 # integrate sin(x) * exp(-x) cc <- gaussLaguerre(17, 0) # we need more nodes sum(cc$w * sin(cc$x)) #=> 0.499999999994907 , should be 0.5 } \keyword{ math } pracma/man/bvp.Rd0000644000176200001440000000417413024246505013355 0ustar liggesusers\name{bvp} \alias{bvp} \title{ Boundary Value Problems } \description{ Solves boundary value problems of linear second order differential equations. } \usage{ bvp(f, g, h, x, y, n = 50) } \arguments{ \item{f, g, h}{functions on the right side of the differential equation. If \code{f, g} or \code{h} is a scalar instead of a function, it is assumed to be a constant coefficient in the differential equation.} \item{x}{\code{x[1], x[2]} are the interval borders where the solution shall be computed.} \item{y}{boundary conditions such that \code{y(x[1]) = y[1], y(x[2]) = y[2]}.} \item{n}{number of intermediate grid points; default 50.} } \details{ Solves the two-point boundary value problem given as a linear differential equation of second order in the form: \deqn{y'' = f(x) y' + g(x) y + h(x)} with the finite element method. The solution \eqn{y(x)} shall exist on the interval \eqn{[a, b]} with boundary conditions \eqn{y(a) = y_a} and \eqn{y(b) = y_b}. } \value{ Returns a list \code{list(xs, ys)} with the grid points \code{xs} and the values \code{ys} of the solution at these points, including the boundary points. } \references{ Kutz, J. N. (2005). Practical Scientific Computing. Lecture Notes 98195-2420, University of Washington, Seattle. } \note{ Uses a tridiagonal equation solver that may be faster then \code{qr.solve} for large values of \code{n}. } \seealso{ \code{\link{shooting}} } \examples{ ## Solve y'' = 2*x/(1+x^2)*y' - 2/(1+x^2) * y + 1 ## with y(0) = 1.25 and y(4) = -0.95 on the interval [0, 4]: f1 <- function(x) 2*x / (1 + x^2) f2 <- function(x) -2 / (1 + x^2) f3 <- function(x) rep(1, length(x)) # vectorized constant function 1 x <- c(0.0, 4.0) y <- c(1.25, -0.95) sol <- bvp(f1, f2, f3, x, y) \dontrun{ plot(sol$xs, sol$ys, ylim = c(-2, 2), xlab = "", ylab = "", main = "Boundary Value Problem") # The analytic solution is sfun <- function(x) 1.25 + 0.4860896526*x - 2.25*x^2 + 2*x*atan(x) - 1/2 * log(1+x^2) + 1/2 * x^2 * log(1+x^2) xx <- linspace(0, 4) yy <- sfun(xx) lines(xx, yy, col="red") grid()} } \keyword{ ode } pracma/man/pinv.Rd0000644000176200001440000000271214072313323013533 0ustar liggesusers\name{pinv} \alias{pinv} \title{ Pseudoinverse or Generalized Inverse } \description{ Computes the Moore-Penrose generalized inverse of a matrix. } \usage{ pinv(A, tol=.Machine$double.eps^(2/3)) } \arguments{ \item{A}{real or complex matrix} \item{tol}{tolerance used for assuming an eigenvalue is zero.} } \details{ Compute the generalized inverse \code{B} of a matrix \code{A} using the singular value decomposition \code{svd()}. This generalized invers is characterized by this equation: \code{A \%*\% B \%*\% A == A} The pseudoinverse \eqn{B} solves the problem to minimize \eqn{|A x - b|} by setting \eqn{x = B b} \code{s <- svd(A)}\cr \code{D <- diag(s\$d)}\cr \code{Dinv <- diag(1/s\$d)}\cr \code{U <- s\$u; V <- s\$v}\cr \code{X = V Dinv t(U)} Thus \code{B} is computed as \code{s$v \%*\% diag(1/s$d) \%*\% t(s$u)}. } \value{ The pseudoinverse of matrix \code{A}. } \references{ Ben-Israel, A., and Th. N. E. Greville (2003). Generalized Inverses - Theory and Applications. Springer-Verlag, New York. } \note{ The pseudoinverse or `generalized inverse' is also provided by the function \code{ginv()} in package `MASS'. It is included in a somewhat simplified way to be independent of that package. } \seealso{ \code{MASS::ginv} } \examples{ A <- matrix(c(7,6,4,8,10,11,12,9,3,5,1,2), 3, 4) b <- apply(A, 1, sum) # 32 16 20 row sum x <- pinv(A) \%*\% b A \%*\% x #=> 32 16 20 as column vector } \keyword{ array } pracma/man/angle.Rd0000644000176200001440000000160712001565513013647 0ustar liggesusers\name{angle} \alias{Real} \alias{Imag} \alias{angle} \title{Basic Complex Functions} \description{ Basic complex functions (Matlab style) } \usage{ Real(z) Imag(z) angle(z) } \arguments{ \item{z}{Vector or matrix of real or complex numbers} } \details{ These are just Matlab names for the corresponding functions in R. The \code{angle} function is simply defined as \code{atan2(Im(z), Re(z))}. } \value{ returning real or complex values; \code{angle} returns in radians. } \note{ The true Matlab names are \code{real}, \code{imag}, and \code{conj}, but as \code{real} was taken in R, all these beginnings are changed to capitals. The function \code{Mod} has no special name in Matlab; use \code{abs()} instead. } \seealso{ \code{\link{Mod}}, \code{\link{abs}} } \examples{ z <- c(0, 1, 1+1i, 1i) Real(z) # Re(z) Imag(z) # Im(z) Conj(z) # Conj(z) abs(z) # Mod(z) angle(z) } \keyword{ arith } pracma/man/randortho.Rd0000644000176200001440000000317013352135710014560 0ustar liggesusers\name{randortho} \alias{randortho} \title{ Generate Random Orthonormal or Unitary Matrix } \description{ Generates random orthonormal or unitary matrix of size \code{n}. Will be needed in applications that explore high-dimensional data spaces, for example optimization procedures or Monte Carlo methods. } \usage{ randortho(n, type = c("orthonormal", "unitary")) } \arguments{ \item{n}{positive integer.} \item{type}{orthonormal (i.e., real) or unitary (i.e., complex) matrix.} } \details{ Generates orthonormal or unitary matrices \code{Q}, that is \code{t(Q)} resp \code{t(Conj(Q))} is inverse to \code{Q}. The randomness is meant with respect to the (additively invariant) Haar measure on \eqn{O(n)} resp. \eqn{U(n)}. Stewart (1980) describes a way to generate such matrices by applying Householder transformation. Here a simpler approach is taken based on the QR decomposition, see Mezzadri (2006), } \value{ Orthogonal (or unitary) matrix \code{Q} of size \code{n}, that is \code{Q \%*\% t(Q)} resp. \code{Q \%*\% t(Conj(Q))} is the unit matrix of size \code{n}. } \note{ \code{rortho} was deprecated and eventually removed in version 2.1.7. } \references{ G. W. Stewart (1980). ``The Efficient Generation of Random Orthogonal Matrices with an Application to Condition Estimators''. SIAM Journal on Numerical Analysis, Vol. 17, No. 3, pp. 403-409. F. Mezzadri (2006). ``How to generate random matrices from the classical compact groups''. NOTICES of the AMS, Vol. 54 (2007), 592-604. (arxiv.org/abs/math-ph/0609050v2) } \examples{ Q <- randortho(5) zapsmall(Q \%*\% t(Q)) zapsmall(t(Q) \%*\% Q) } \keyword{ math } pracma/man/segm_distance.Rd0000644000176200001440000000304712042212424015361 0ustar liggesusers\name{segm_distance} \alias{segm_distance} \title{ Segment Distance } \description{ The minimum distance between a point and a segment, or the minimum distance between points of two segments. } \usage{ segm_distance(p1, p2, p3, p4 = c()) } \arguments{ \item{p1, p2}{end points of the first segment.} \item{p3, p4}{end points of the second segment, or the point \code{p3} alone if \code{p4} is \code{NULL}.} } \details{ If \code{p4=c()}, determines the orthogonal line to the segment through the single point and computes the distance to the intersection point. Otherwise, it computes the distances of all four end points to the other segment and takes the minimum of those. } \value{ Returns a list with component \code{l} the minimum distance and components \code{p, q} the two nearest points. If \code{p4=c()} then point \code{p} lies on the segment and \code{q} is \code{p4}. } \note{ The interfaces of \code{segm_intersect} and \code{segm_distance} should be brought into line. } \seealso{ \code{\link{segm_intersect}} } \examples{ \dontrun{ plot(c(0, 1), c(0, 1), type = "n", asp=1, xlab = "", ylab = "", main = "Segment Distances") grid() for (i in 1:20) { s1 <- matrix(runif(4), 2, 2) s2 <- matrix(runif(4), 2, 2) lines(s1[, 1], s1[, 2], col = "red") lines(s2[, 1], s2[, 2], col = "darkred") S <- segm_distance(s1[1,], s1[2,], s2[1,], s2[2,]) S$d points(c(S$p[1], S$q[1]), c(S$p[2], S$q[2]), pch=20, col="navy") lines(c(S$p[1], S$q[1]), c(S$p[2], S$q[2]), col="gray") }} } \keyword{ geom } pracma/man/conv.Rd0000644000176200001440000000125111563500200013513 0ustar liggesusers\name{conv} \alias{conv} \title{Polynomial Convolution} \description{ Convolution and polynomial multiplication. } \usage{ conv(x, y) } \arguments{ \item{x, y}{real or complex vectors.} } \details{ \code{r = conv(p,q)} convolves vectors \code{p} and \code{q}. Algebraically, convolution is the same operation as multiplying the polynomials whose coefficients are the elements of \code{p} and \code{q}. } \value{ Another vector. } \note{ \code{conv} utilizes fast Fourier transformation. } \seealso{ \code{\link{deconv}}, \code{\link{polyadd}} } \examples{ conv(c(1, 1, 1), 1) conv(c(1, 1, 1), c(0, 0, 1)) conv(c(-0.5, 1, -1), c(0.5, 0, 1)) } \keyword{ timeseries } pracma/man/normest.Rd0000644000176200001440000000267013377021447014263 0ustar liggesusers\name{normest} \alias{normest} \title{ Estimated Matrix Norm } \description{ Estimate the 2-norm of a real (or complex-valued) matrix. 2-norm is also the maximum absolute eigenvalue of M, computed here using the power method. } \usage{ normest(M, maxiter = 100, tol = .Machine$double.eps^(1/2)) } \arguments{ \item{M}{Numeric matrix; vectors will be considered as column vectors.} \item{maxiter}{Maximum number of iterations allowed; default: 100.} \item{tol}{Tolerance used for stopping the iteration.} } \details{ Estimate the 2-norm of the matrix \code{M}, typically used for large or sparse matrices, where the cost of calculating the \code{norm (A)} is prohibitive and an approximation to the 2-norm is acceptable. Theoretically, the 2-norm of a matrix \eqn{M} is defined as \eqn{||M||_2 = max \frac{||M*x||_2}{||x||_2}} for all \eqn{x \neq 0} where \eqn{||.||_2} is the Euclidean/Frobenius norm. } \value{ 2-norm of the matrix as a positive real number. } \references{ Trefethen, L. N., and D. Bau III. (1997). Numerical Linear Algebra. SIAM, Philadelphia. } \note{ If feasible, an accurate value of the 2-norm would simply be calculated as the maximum of the singular values (which are all positive): \code{max(svd(M)\$d)} } \seealso{ \code{\link{cond}}, \code{\link{svd}} } \examples{ normest(magic(5)) == max(svd(magic(5))$d) # TRUE normest(magic(100)) # 500050 } \keyword{ array } pracma/man/linearproj.Rd0000644000176200001440000001333313403535607014735 0ustar liggesusers\name{linearproj, affineproj} \alias{linearproj} \alias{affineproj} \title{ Linear Projection onto a Subspace } \description{ Computes the projection of points in the columns of B onto the linear subspace spaned by the columns of A, resp. the projection of a point onto an affine subspace and its distance. } \usage{ linearproj(A, B) affineproj(x0, C, b, unbound = TRUE, maxniter = 100) } \arguments{ \item{A}{Matrix whose columns span a subspace of some R^n.} \item{B}{Matrix whose columns are to be projected.} \item{x0}{Point in R^n to be projected onto C x = b.} \item{C, b}{Matrix and vector, defining an affine subspace as C x = b} \item{unbound}{Logical; require all x >= 0 if unbound is false.} \item{maxniter}{Maximum number of iterations (if is unbound is false).} } \details{ \code{linearproj} projects points onto a \emph{linear} subspace in R^n. The columns of A are assumed be the basis of a linear subspace, esp. they are required to be linearly independent. The columns of matrix B define points in R^n that will be projected onto A, and their resp. coefficients in terms of the basis in A are computed. The columns of A need to be linearly independent; if not, generate an orthonormal basis of this subspace with \code{orth(A)}. If you want to project points onto a subspace that is defined by \code{A x = 0}, then generate an orthonormal basis of the nullspace of A with \code{null(A)}. Technically, the orthogonal projection can be determined by a finite 'Fourier expansion' with coefficients calculated as scalar products, see the examples. \code{affineproj} projects (single) points onto an affine subspace defined by \code{A x = b} and calculates the distance of \code{x0} from this subspace. The calculation is based on the following formula: \deqn{p = (I - A' (A A')^{-1}) x0 + A' (A A')^{-1} b} Technically, if \code{a} is one solution of \code{C x = b}, then the projection onto C can be derived from the projection onto S = {C x = 0} with \code{proj_C(x) = a + proj_S(x - a)}, see the examples. In case the user requests the coordinates of the projected point to be positive, an iteration procedure is started where negative coordinates are set to zero in each iteration. } \value{ The functions \code{linearproj} returns a list with components P and Q. The columns of P contain the coefficients -- in the basis of A -- of the corresponding projected points in B, and the columns of Q are the the coordinates of these points in the natural coordinate system of R^n. \code{affineproj} returns a list with components \code{proj}, \code{dist}, and \code{niter}. \code{proj} is the projected point, \code{dist} the distance from the subspace (and \code{niter} the number of iterations if positivity of the coordinates was requested.). } \references{ G. Strang (2006). Linear Algebra and Its Applications. Fourth Edition, Cengage Learning, Boston, MA. } \note{ Some timings show that these implementations are to a certain extent competitive with direct applications of quadprog. } \author{ Hans W. Borchers, partly based on code snippets by Ravi Varadhan. } \seealso{ \code{\link{nullspace}}, \code{\link{orth}} } \examples{ #-- Linear projection -------------------------------------------------- # Projection onto the line (1,1,1) in R^3 A <- matrix(c(1,1,1), 3, 1) B <- matrix(c(1,0,0, 1,2,3, -1,0,1), 3, 3) S <- linearproj(A, B) ## S$Q ## [,1] [,2] [,3] ## [1,] 0.3333333 2 0 ## [2,] 0.3333333 2 0 ## [3,] 0.3333333 2 0 # Fourier expansion': sum( a_i /), a_i = A[ ,i] dot(c(1,2,3), A) * A / dot(A, A) # A has only one column #-- Affine projection -------------------------------------------------- # Projection onto the (hyper-)surface x+y+z = 1 in R^3 A <- t(A); b <- 1 x0 <- c(1,2,3) affineproj(x0, A, b) # (-2/3, 1/3, 4/3) # Linear translation: Let S be the linear subspace and A the parallel # affine subspace of A x = b, a the solution of the linear system, then # proj_A(x) = a + proj_S(x-a) a <- qr.solve(A, b) A0 <- nullspace(A) xp <- c(a + linearproj(A0, x0 - a)$Q) ## [1] -0.6666667 0.3333333 1.3333333 #-- Projection with positivity ----------------------- 24 ms -- 1.3 s -- s <- affineproj(x0, A, b, unbound = FALSE) zapsmall(s$proj) # [1] 0 0 1 ## $x : 0.000000e+00 3.833092e-17 1.000000e+00 ## $niter : 35 #-- Extended Example ------------------------------------------ 80 ms -- \dontrun{ set.seed(65537) n = 1000; m = 100 # dimension, codimension x0 <- rep(0, n) # project (0, ..., 0) A <- matrix(runif(m*n), nrow = m) # 100 x 1000 b <- rep(1, m) # A x = b, linear system a <- qr.solve(A, b) # A a = b, LS solution A0 <- nullspace(A) # 1000 x 900, base of xp <- a+drop(A0 \%*\% dot(x0-a, A0)) # projection Norm(xp - x0) # [1] 0.06597077 } #-- Solution with quadprog ------------------------------------ 40 ms -- # D <- diag(1, n) # quadratic form # A1 <- rbind(A, diag(1, n)) # A x = b and # b1 <- c(b, rep(0, n)) # x >= 0 # n <- nrow(A) # sol = quadprog::solve.QP(D, x0, t(A1), b1, meq = n) # xp <- sol$solution #-- Solution with CVXR ---------------------------------------- 50 ms -- # library(CVXR) # x = Variable(n) # n decision variables # objective = Minimize(p_norm(x0 - x)) # min! || p0 - x || # constraint = list(A %*% x == b, x >= 0) # A x = b, x >= 0 # problem = Problem(objective, constraint) # solution = solve(problem) # Solver: ECOS # solution$value # # xp <- solution$getValue(x) # } \keyword{ math } pracma/man/tri.Rd0000644000176200001440000000206712042212424013353 0ustar liggesusers\name{tri} \alias{tril} \alias{triu} \title{ Triangular Matrices (Matlab Style) } \description{ Extract lower or upper triangular part of a matrix. } \usage{ tril(M, k = 0) triu(M, k = 0) } \arguments{ \item{M}{numeric matrix.} \item{k}{integer, indicating a secondary diagonal.} } \details{ \code{tril}\cr Returns the elements on and below the kth diagonal of X, where k = 0 is the main diagonal, k > 0 is above the main diagonal, and k < 0 is below the main diagonal. \code{triu}\cr Returns the elements on and above the kth diagonal of X, where k = 0 is the main diagonal, k > 0 is above the main diagonal, and k < 0 is below the main diagonal. } \value{ Matrix the same size as the input matrix. } \note{ For \code{k==0} it is simply an application of the R functions \code{lower.tri} resp. \code{upper.tri}. } \seealso{ \code{\link{Diag}} } \examples{ tril(ones(4,4), +1) # 1 1 0 0 # 1 1 1 0 # 1 1 1 1 # 1 1 1 1 triu(ones(4,4), -1) # 1 1 1 1 # 1 1 1 1 # 0 1 1 1 # 0 0 1 1 } \keyword{ array } pracma/man/newtonRaphson.Rd0000644000176200001440000000317013342034603015423 0ustar liggesusers\name{newtonRaphson} \alias{newtonRaphson} \alias{newton} \title{ Rootfinding through Newton-Raphson or Secant. } \description{ Finding roots of univariate functions. (Newton never invented or used this method; it should be called more appropriately Simpson's method!) } \usage{ newtonRaphson(fun, x0, dfun = NULL, maxiter = 500, tol = 1e-08, ...) newton(fun, x0, dfun = NULL, maxiter = 500, tol = 1e-08, ...) } \arguments{ \item{fun}{Function or its name as a string.} \item{x0}{starting value for newtonRaphson().} \item{dfun}{A function to compute the derivative of \code{f}. If \code{NULL}, a numeric derivative will be computed.} \item{maxiter}{maximum number of iterations; default 100.} \item{tol}{absolute tolerance; default \code{eps^(1/2)}} \item{...}{Additional arguments to be passed to f.} } \details{ Well known root finding algorithms for real, univariate, continuous functions. } \value{ Return a list with components \code{root}, \code{f.root}, the function value at the found root, \code{iter}, the number of iterations done, and \code{root}, and the estimated precision \code{estim.prec} The estimated precision is given as the difference to the last solution before stop; this may be misleading. } \references{ Quarteroni, A., R. Sacco, and F. Saleri (2007). Numerical Mathematics. Second Edition, Springer-Verlag, Berlin Heidelberg. } \seealso{ \code{\link{newtonHorner}} } \examples{ # Legendre polynomial of degree 5 lp5 <- c(63, 0, -70, 0, 15, 0)/8 f <- function(x) polyval(lp5, x) newton(f, 1.0) # 0.9061798459 correct to 10 decimals in 5 iterations } \keyword{ math } pracma/man/rank.Rd0000644000176200001440000000201412042212424013500 0ustar liggesusers\name{Rank} \alias{Rank} \title{ Matrix Rank } \description{ Provides an estimate of the rank of a matrix \code{M}. } \usage{ Rank(M) } \arguments{ \item{M}{Numeric matrix; vectors will be considered as column vectors.} } \details{ Provides an estimate of the number of linearly independent rows or columns of a matrix \code{M}. Compares an approach using QR-decomposition with one counting singular values larger than a certain tolerance (Matlab). } \value{ Matrix rank as integer between \code{0} and \code{min(ncol(M), nrow(M))}. } \references{ Trefethen, L. N., and D. Bau III. (1997). Numerical Linear Algebra. SIAM, Philadelphia. } \note{ The corresponding function in Matlab is called \code{rank}, but that term has a different meaning in R. } \seealso{ \code{\link{nullspace}} } \examples{ Rank(magic(10)) #=> 7 Rank(magic(100)) #=> 3 (!) Rank(hilb(8)) #=> 8 , but qr(hilb(8))$rank says, rank is 7. # Warning message: # In Rank(hilb(8)) : Rank calculation may be problematic. } \keyword{ array } pracma/man/isprime.Rd0000644000176200001440000000166012042212424014223 0ustar liggesusers\name{isprime} \alias{isprime} \title{isprime Property} \description{ Vectorized version, returning for a vector or matrix of positive integers a vector of the same size containing 1 for the elements that are prime and 0 otherwise. } \usage{ isprime(x) } \arguments{ \item{x}{vector or matrix of nonnegative integers} } \details{ Given an array of positive integers returns an array of the same size of 0 and 1, where the i indicates a prime number in the same position. } \value{ array of elements 0, 1 with 1 indicating prime numbers } \seealso{ \code{\link{factors}, \link{primes}} } \examples{ x <- matrix(1:10, nrow=10, ncol=10, byrow=TRUE) x * isprime(x) # Find first prime number octett: octett <- c(0, 2, 6, 8, 30, 32, 36, 38) - 19 while (TRUE) { octett <- octett + 210 if (all(as.logical(isprime(octett)))) { cat(octett, "\n", sep=" ") break } } } \keyword{ math } pracma/man/vectorfield.Rd0000644000176200001440000000213211567721641015075 0ustar liggesusers\name{vectorfield} \alias{vectorfield} \title{ Vector Field Plotting } \description{ Plotting a vector field } \usage{ vectorfield(fun, xlim, ylim, n = 16, scale = 0.05, col = "green", ...) } \arguments{ \item{fun}{function of two variables --- must be vectorized.} \item{xlim}{range of \code{x} values.} \item{ylim}{range of \code{y} values.} \item{n}{grid size, proposed 16 in each direction.} \item{scale}{scales the length of the arrows.} \item{col}{arrow color, proposed `green'.} \item{...}{more options presented to the \code{arrows} primitive.} } \details{ Plots a vector field for a function \code{f}. Main usage could be to plot the solution of a differential equation into the same graph. } \value{ Opens a graph window and plots the vector field. } \seealso{ \code{\link{quiver}}, \code{\link{arrows}} } \examples{ f <- function(x, y) x^2 - y^2 xx <- c(-1, 1); yy <- c(-1, 1) \dontrun{ vectorfield(f, xx, yy, scale = 0.1) for (xs in seq(-1, 1, by = 0.25)) { sol <- rk4(f, -1, 1, xs, 100) lines(sol$x, sol$y, col="darkgreen") } grid()} } \keyword{ graphs } pracma/man/fderiv.Rd0000644000176200001440000000453112105737273014050 0ustar liggesusers\name{fderiv} \alias{fderiv} \title{ Numerical Differentiation } \description{ Numerical function differentiation for orders \code{n=1..4} using finite difference approximations. } \usage{ fderiv(f, x, n = 1, h = 0, method = c("central", "forward", "backward"), ...) } \arguments{ \item{f}{function to be differentiated.} \item{x}{point(s) where differentiation will take place.} \item{n}{order of derivative, should only be between 1 and 8; for \code{n=0} function values will be returned.} \item{h}{step size: if \code{h=0} step size will be set automatically.} \item{method}{one of ``central'', ``forward'', or ``backward''.} \item{...}{more variables to be passed to function \code{f}.} } \details{ Derivatives are computed applying central difference formulas that stem from the Taylor series approximation. These formulas have a convergence rate of \eqn{O(h^2)}. Use the `forward' (right side) or `backward' (left side) method if the function can only be computed or is only defined on one side. Otherwise, always use the central difference formulas. Optimal step sizes depend on the accuracy the function can be computed with. Assuming internal functions with an accuracy 2.2e-16, appropriate step sizes might be \code{5e-6, 1e-4, 5e-4, 2.5e-3} for \code{n=1,...,4} and precisions of about \code{10^-10, 10^-8, 5*10^-7, 5*10^-6} (at best). For \code{n>4} a recursion (or finite difference) formula will be applied, cd. the Wikipedia article on ``finite difference''. } \value{ Vector of the same length as \code{x}. } \references{ Kiusalaas, J. (2005). Numerical Methods in Engineering with Matlab. Cambridge University Press. } \note{ Numerical differentiation suffers from the conflict between round-off and truncation errors. } \seealso{ \code{\link{numderiv}}, \code{\link{taylor}} } \examples{ \dontrun{ f <- sin xs <- seq(-pi, pi, length.out = 100) ys <- f(xs) y1 <- fderiv(f, xs, n = 1, method = "backward") y2 <- fderiv(f, xs, n = 2, method = "backward") y3 <- fderiv(f, xs, n = 3, method = "backward") y4 <- fderiv(f, xs, n = 4, method = "backward") plot(xs, ys, type = "l", col = "gray", lwd = 2, xlab = "", ylab = "", main = "Sinus and its Derivatives") lines(xs, y1, col=1, lty=2) lines(xs, y2, col=2, lty=3) lines(xs, y3, col=3, lty=4) lines(xs, y4, col=4, lty=5) grid()} } \keyword{ math } pracma/man/fminsearch.Rd0000644000176200001440000000453013452637217014712 0ustar liggesusers\name{fminsearch} \alias{fminsearch} \title{ Derivative-free Nonlinear Function Minimization } \description{ Find minimum of multivariable functions using derivative-free methods. } \usage{ fminsearch(fn, x0, ..., lower = NULL, upper = NULL, method = c("Nelder-Mead", "Hooke-Jeeves"), minimize = TRUE, maxiter = 1000, tol = 1e-08) } \arguments{ \item{fn}{function whose minimum or maximum is to be found.} \item{x0}{point considered near to the optimum.} \item{...}{additional variables to be passed to the function.} \item{lower, upper}{lower and upper bounds constraints.} \item{method}{"Nelder-Mead" (default) or "Hooke-Jeeves"; can be abbreviated.} \item{minimize}{logical; shall a minimum or a maximum be found.} \item{maxiter}{maximal number of iterations} \item{tol}{relative tolerance.} } \details{ \code{fminsearch} finds the minimum of a nonlinear scalar multivariable function, starting at an initial estimate and returning a value x that is a local minimizer of the function. With \code{minimize=FALSE} it searches for a maximum, by default for a (local) minimum. As methods/solvers "Nelder-Mead" and "Hooke-Jeeves" are available. Only Hooke-Jeeves can handle bounds constraints. For nonlinear constraints see \code{fmincon}, and for methods using gradients see \code{fminunc}. Important: \code{fminsearch} may only give local solutions. } \value{ List with \item{xopt}{location of the location of minimum resp. maximum.} \item{fmin}{function value at the optimum.} \item{count}{number of function calls.} \item{convergence}{info about convergence: not used at the moment.} \item{info}{special information from the solver.} } \references{ Nocedal, J., and S. Wright (2006). Numerical Optimization. Second Edition, Springer-Verlag, New York. } \note{ \code{fminsearch} mimics the Matlab function of the same name. } \seealso{ \code{\link{nelder_mead}}, \code{\link{hooke_jeeves}} } \examples{ # Rosenbrock function rosena <- function(x, a) 100*(x[2]-x[1]^2)^2 + (a-x[1])^2 # min: (a, a^2) fminsearch(rosena, c(-1.2, 1), a = sqrt(2), method="Nelder-Mead") ## $xmin $fmin ## [1] 1.414292 2.000231 [1] 1.478036e-08 fminsearch(rosena, c(-1.2, 1), a = sqrt(2), method="Hooke-Jeeves") ## $xmin $fmin ## [1] 1.414215 2.000004 [1] 1.79078e-12 } \keyword{ optimize } pracma/man/ezpolar.Rd0000644000176200001440000000122712062032441014227 0ustar liggesusers\name{ezpolar} \alias{ezpolar} \title{ Easy Polar Plot } \description{ Easy function plot w/o the need to define \code{x, y} coordinates. } \usage{ ezpolar(fun, interv = c(0, 2*pi)) } \arguments{ \item{fun}{function to be plotted.} \item{interv}{left and right endpoint for the plot.} } \details{ Calculates the \code{x, y} coordinates of points to be plotted and calls the \code{polar} function. } \value{ Plots the function graph and invisibly returns \code{NULL}. } \note{ Mimick the Matlab function of the same name. } \seealso{ \code{\link{ezplot}} } \examples{ \dontrun{ fun <- function(x) 1 + cos(x) ezpolar(fun) } } \keyword{ graphs } pracma/man/agmean.Rd0000644000176200001440000000367114000041732014005 0ustar liggesusers\name{agmean} \alias{agmean} \title{ Arithmetic-geometric Mean } \description{ The arithmetic-geometric mean of real or complex numbers. } \usage{ agmean(a, b) } \arguments{ \item{a, b}{vectors of real or complex numbers of the same length (or scalars).} } \details{ The arithmetic-geometric mean is defined as the common limit of the two sequences \eqn{a_{n+1} = (a_n + b_n)/2} and \eqn{b_{n+1} = \sqrt(a_n b_n)}. When used for negative or complex numbers, the complex square root function is applied. } \value{ Returns a list with compoinents: \code{agm} a vector of arithmetic-geometric means, component-wise, \code{niter} the number of iterations, and \code{prec} the overall estimated precision. } \note{ Gauss discovered that elliptic integrals can be effectively computed via the arithmetic-geometric mean (see example below), for example: \deqn{\int_0^{\pi/2} \frac{dt}{\sqrt{1 - m^2 sin^2(t)}} = \frac{(a+b) \pi}{4 \cdot agm(a,b)}} where \eqn{m = (a-b)/(a+b)} } \references{ \url{https://mathworld.wolfram.com/Arithmetic-GeometricMean.html} } \seealso{ Arithmetic, geometric, and harmonic mean. } \examples{ ## Accuracy test: Gauss constant 1/agmean(1, sqrt(2))$agm - 0.834626841674073186 # 1.11e-16 < eps = 2.22e-16 ## Gauss' AGM-based computation of \pi a <- 1.0 b <- 1.0/sqrt(2) s <- 0.5 d <- 1L while (abs(a-b) > eps()) { t <- a a <- (a + b)*0.5 b <- sqrt(t*b) c <- (a-t)*(a-t) d <- 2L * d s <- s - d*c } approx_pi <- (a+b)^2 / s / 2.0 abs(approx_pi - pi) # 8.881784e-16 in 4 iterations ## Example: Approximate elliptic integral N <- 20 m <- seq(0, 1, len = N+1)[1:N] E <- numeric(N) for (i in 1:N) { f <- function(t) 1/sqrt(1 - m[i]^2 * sin(t)^2) E[i] <- quad(f, 0, pi/2) } A <- numeric(2*N-1) a <- 1 b <- a * (1-m) / (m+1) \dontrun{ plot(m, E, main = "Elliptic Integrals vs. arith.-geom. Mean") lines(m, (a+b)*pi / 4 / agmean(a, b)$agm, col="blue") grid()} } \keyword{ arith } pracma/man/fact.Rd0000644000176200001440000000263412542771664013517 0ustar liggesusers\name{fact} \alias{fact} \alias{factorial2} \title{ Factorial Function } \description{ Factorial for non-negative integers \code{n <= 170}. } \usage{ fact(n) factorial2(n) } \arguments{ \item{n}{Vector of integers, for \code{fact}, resp. a single integer for \code{factorial2}.} } \details{ The factorial is computed by brute force; factorials for \code{n >= 171} are not representable as `double' anymore. } \value{ \code{fact} returns the factorial of each element in \code{n}. If \code{n < 0} the value is \code{NaN}, and for \code{n > 170} it is \code{Inf}. Non-integers will be reduced to integers through \code{floor(n)}. \code{factorial2} returns the product of all even resp. odd integers, depending on whether \code{n} is even or odd. } \note{ The R core function \code{factorial} uses the \code{gamma} function, whose implementation is not accurate enough for larger input values. } \seealso{ \code{\link{factorial}} } \examples{ fact(c(-1, 0, 1, NA, 171)) #=> NaN 1 1 NA Inf fact(100) #=> 9.332621544394410e+157 factorial(100) #=> 9.332621544394225e+157 # correct value: 9.332621544394415e+157 # Stirling's approximation: 9.324847625269420e+157 # n! ~ sqrt(2*pi*n) * (n/e)^n factorial2(8); factorial2(9); factorial2(10) # 384 945 3840 factorial(10) / factorial2(10) # => factorial2(9) } \keyword{ math } pracma/man/akima.Rd0000644000176200001440000000364712206645567013670 0ustar liggesusers\name{akimaInterp} \alias{akimaInterp} \title{ Univariate Akima Interpolation } \description{ Interpolate smooth curve through given points on a plane. } \usage{ akimaInterp(x, y, xi) } \arguments{ \item{x, y}{x/y-coordinates of (irregular) grid points defining the curve.} \item{xi}{x-coordinates of points where to interpolate.} } \details{ Implementation of Akima's univariate interpolation method, built from piecewise third order polynomials. There is no need to solve large systems of equations, and the method is therefore computationally very efficient. } \value{ Returns the interpolated values at the points \code{xi} as a vector. } \note{ There is also a 2-dimensional version in package `akima'. } \author{ Matlab code by H. Shamsundar under BSC License; re-implementation in R by Hans W Borchers. } \references{ Akima, H. (1970). A New Method of Interpolation and Smooth Curve Fitting Based on Local Procedures. Journal of the ACM, Vol. 17(4), pp 589-602. Hyman, J. (1983). Accurate Monotonicity Preserving Cubic Interpolation. SIAM J. Sci. Stat. Comput., Vol. 4(4), pp. 645-654. Akima, H. (1996). Algorithm 760: Rectangular-Grid-Data Surface Fitting that Has the Accurancy of a Bicubic Polynomial. ACM TOMS Vol. 22(3), pp. 357-361. Akima, H. (1996). Algorithm 761: Scattered-Data Surface Fitting that Has the Accuracy of a Cubic Polynomial. ACM TOMS, Vol. 22(3), pp. 362-371. } \seealso{ \code{\link{kriging}}, \code{akima::aspline}, \code{akima::interp} } \examples{ x <- c( 0, 2, 3, 5, 6, 8, 9, 11, 12, 14, 15) y <- c(10, 10, 10, 10, 10, 10, 10.5, 15, 50, 60, 85) xs <- seq(12, 14, 0.5) # 12.0 12.5 13.0 13.5 14.0 ys <- akimaInterp(x, y, xs) # 50.0 54.57405 54.84360 55.19135 60.0 xs; ys \dontrun{ plot(x, y, col="blue", main = "Akima Interpolation") xi <- linspace(0,15,51) yi <- akimaInterp(x, y, xi) lines(xi, yi, col = "darkred") grid()} } \keyword{ fitting } pracma/man/fractalcurve.Rd0000644000176200001440000000531012660202404015233 0ustar liggesusers\name{fractalcurve} \alias{fractalcurve} \title{ Fractal Curves } \description{ Generates the following fractal curves: Dragon Curve, Gosper Flowsnake Curve, Hexagon Molecule Curve, Hilbert Curve, Koch Snowflake Curve, Sierpinski Arrowhead Curve, Sierpinski (Cross) Curve, Sierpinski Triangle Curve. } \usage{ fractalcurve(n, which = c("hilbert", "sierpinski", "snowflake", "dragon", "triangle", "arrowhead", "flowsnake", "molecule")) } \arguments{ \item{n}{integer, the `order' of the curve} \item{which}{character string, which curve to cumpute.} } \details{ The Hilbert curve is a continuous curve in the plane with 4^N points. The Sierpinski (cross) curve is a closed curve in the plane with 4^(N+1)+1 points. His arrowhead curve is a continuous curve in the plane with 3^N+1 points, and his triangle curve is a closed curve in the plane with 2*3^N+2 points. The Koch snowflake curve is a closed curve in the plane with 3*2^N+1 points. The dragon curve is a continuous curve in the plane with 2^(N+1) points. The flowsnake curve is a continuous curve in the plane with 7^N+1 points. The hexagon molecule curve is a closed curve in the plane with 6*3^N+1 points. } \value{ Returns a list with \code{x, y} the x- resp. y-coordinates of the generated points describing the fractal curve. } \references{ Peitgen, H.O., H. Juergens, and D. Saupe (1993). Fractals for the Classroom. Springer-Verlag Berlin Heidelberg. } \author{ Copyright (c) 2011 Jonas Lundgren for the Matlab toolbox \code{fractal curves} available on MatlabCentral under BSD license; here re-implemented in R with explicit allowance from the author. } \examples{ ## The Hilbert curve transforms a 2-dim. function into a time series. z <- fractalcurve(4, which = "hilbert") \dontrun{ f1 <- function(x, y) x^2 + y^2 plot(f1(z$x, z$y), type = 'l', col = "darkblue", lwd = 2, ylim = c(-1, 2), main = "Functions transformed by Hilbert curves") f2 <- function(x, y) x^2 - y^2 lines(f2(z$x, z$y), col = "darkgreen", lwd = 2) f3 <- function(x, y) x^2 * y^2 lines(f3(z$x, z$y), col = "darkred", lwd = 2) grid()} \dontrun{ ## Show some more fractal surves n <- 8 opar <- par(mfrow=c(2,2), mar=c(2,2,1,1)) z <- fractalcurve(n, which="dragon") x <- z$x; y <- z$y plot(x, y, type='l', col="darkgrey", lwd=2) title("Dragon Curve") z <- fractalcurve(n, which="molecule") x <- z$x; y <- z$y plot(x, y, type='l', col="darkblue") title("Molecule Curve") z <- fractalcurve(n, which="arrowhead") x <- z$x; y <- z$y plot(x, y, type='l', col="darkgreen") title("Arrowhead Curve") z <- fractalcurve(n, which="snowflake") x <- z$x; y <- z$y plot(x, y, type='l', col="darkred", lwd=2) title("Snowflake Curve") par(opar)} } \keyword{ math } pracma/man/jacobian.Rd0000644000176200001440000000237612101433324014326 0ustar liggesusers\name{jacobian} \alias{jacobian} \title{Jacobian Matrix} \description{ Jacobian matrix of a function R^n --> R^m . } \usage{ jacobian(f, x0, heps = .Machine$double.eps^(1/3), ...) } \arguments{ \item{f}{\code{m} functions of \code{n} variables.} \item{x0}{Numeric vector of length \code{n}.} \item{heps}{This is \code{h} in the derivative formula.} \item{...}{parameters to be passed to f.} } \details{ Computes the derivative of each funktion \eqn{f_j} by variable \eqn{x_i} separately, taking the discrete step \eqn{h}. } \value{ Numeric \code{m}-by-\code{n} matrix \code{J} where the entry \code{J[j, i]} is \eqn{\frac{\partial f_j}{\partial x_i}}, i.e. the derivatives of function \eqn{f_j} line up in row \eqn{i} for \eqn{x_1, \ldots, x_n}. } \references{ Quarteroni, A., R. Sacco, and F. Saleri (2007). Numerical Mathematics. Second Edition, Springer-Verlag, Berlin Heidelberg. } \note{ Obviously, this function is \emph{not} vectorized. } \seealso{ \code{gradient} } \examples{ ## Example function from Quarteroni & Saleri f <- function(x) c(x[1]^2 + x[2]^2 - 1, sin(pi*x[1]/2) + x[2]^3) jf <- function(x) matrix( c(2*x[1], pi/2 * cos(pi*x[1]/2), 2*x[2], 3*x[2]^2), 2, 2) all.equal(jf(c(1,1)), jacobian(f, c(1,1))) # TRUE } \keyword{ math } pracma/man/quadprog.Rd0000644000176200001440000000531412740250175014407 0ustar liggesusers\name{quadprog} \alias{quadprog} \title{ Quadratic Programming } \description{ Solves quadratic programming problems with linear and box constraints. } \usage{ quadprog(C, d, A = NULL, b = NULL, Aeq = NULL, beq = NULL, lb = NULL, ub = NULL) } \arguments{ \item{C}{symmetric matrix, representing the quadratic term.} \item{d}{vector, representing the linear term.} \item{A}{matrix, represents the linear constraint coefficients.} \item{b}{vector, constant vector in the constraints.} \item{Aeq}{matrix, linear equality constraint coefficients.} \item{beq}{vector, constant equality constraint vector.} \item{lb}{elementwise lower bounds.} \item{ub}{elementwise upper bounds.} } \details{ Finds a minimum for the quadratic programming problem specified as: \deqn{min 1/2 x'Cx + d'x} such that the following constraints are satisfied: \deqn{A x <= b} \deqn{Aeq x = beq} \deqn{lb <= x <= ub} The matrix should be symmetric and positive definite, in which case the solution is unique, indicated when the exit flag is 1. For more information, see \code{?solve.QP}. } \value{ Returns a list with components \item{xmin}{minimum solution, subject to all bounds and constraints.} \item{fval}{value of the target expression at the arg minimum.} \item{eflag}{exit flag.} } \references{ Nocedal, J., and St. J. Wright (2006). Numerical Optimization. Second Edition, Springer Series in Operations Research, New York. } \note{ This function is wrapping the active set quadratic solver in the \code{quadprog} package: \code{quadprog::solve.QP}, combined with a more MATLAB-like API interface. } \seealso{ \code{\link{lsqlincon}}, \code{quadprog::solve.QP} } \examples{ ## Example in ?solve.QP # Assume we want to minimize: 1/2 x^T x - (0 5 0) %*% x # under the constraints: A x <= b # with b = (8,-2, 0) # and ( 4 3 0) # A = (-2 -1 0) # ( 0 2,-1) # and possibly equality constraint 3x1 + 2x2 + x3 = 1 # or upper bound c(1.5, 1.5, 1.5). C <- diag(1, 3); d <- -c(0, 5, 0) A <- matrix(c(4,3,0, -2,-1,0, 0,2,-1), 3, 3, byrow=TRUE) b <- c(8, -2, 0) quadprog(C, d, A, b) # $xmin # [1] 0.4761905 1.0476190 2.0952381 # $fval # [1] -2.380952 # $eflag # [1] 1 Aeq <- c(3, 2, 1); beq <- 1 quadprog(C, d, A, b, Aeq, beq) # $xmin # [1] 1.4 -0.8 -1.6 # $fval # [1] 6.58 # $eflag # [1] 1 quadprog(C, d, A, b, lb = 0, ub = 1.5) # $xmin # [1] 0.625 0.750 1.500 # $fval # [1] -2.148438 # $eflag # [1] 1 ## Example help(quadprog) C <- matrix(c(1, -1, -1, 2), 2, 2) d <- c(-2, -6) A <- matrix(c(1,1, -1,2, 2,1), 3, 2, byrow=TRUE) b <- c(2, 2, 3) lb <- c(0, 0) quadprog(C, d, A, b, lb=lb) # $xmin # [1] 0.6666667 1.3333333 # $fval # [1] -8.222222 # $eflag # [1] 1 } \keyword{ optimize } pracma/man/hadamard.Rd0000644000176200001440000000143712465405723014335 0ustar liggesusers\name{hadamard} \alias{hadamard} \title{Hadamard Matrix} \description{ Generate Hadamard matrix of a certain size. } \usage{ hadamard(n) } \arguments{ \item{n}{An integer of the form 2^e, 12*2^e, or 20*2^e} } \details{ An \code{n}-by-\code{n} Hadamard matrix with \code{n>2} exists only if \code{rem(n,4)=0}. This function handles only the cases where \code{n}, \code{n/12}, or \code{n/20} is a power of 2. } \value{ Matrix of size \code{n}-by-\code{n} of orthogonal columns consisting of 1 and -1 only. } \note{ Hadamard matrices have applications in combinatorics, signal processing, and numerical analysis. } \seealso{ \code{\link{hankel}}, \code{\link{Toeplitz}} } \examples{ hadamard(4) H <- hadamard(8) t(H) %*% H # t(H) %*% H == diag(n, n, n) } \keyword{ specmat } pracma/man/hilb.Rd0000644000176200001440000000100512465405723013501 0ustar liggesusers\name{hilb} \alias{hilb} \title{Hilbert Matrix} \description{ Generate Hilbert matrix of dimension n } \usage{ hilb(n) } \arguments{ \item{n}{positive integer specifying the dimension of the Hilbert matrix} } \details{ Generate the Hilbert matrix \code{H} of dimension \code{n} with elements \code{H[i, j] = 1/(i+j-1)}. (Note: This matrix is ill-conditioned, see e.g. \code{det(hilb(6))}.) } \value{ matrix of dimension n } \seealso{ \code{\link{vander}} } \examples{ hilb(5) } \keyword{ specmat } pracma/man/gammaz.Rd0000644000176200001440000000216712465405723014051 0ustar liggesusers\name{gammaz} \alias{gammaz} \title{ Complex Gamma Function } \description{ Gamma function valid in the entire complex plane. } \usage{ gammaz(z) } \arguments{ \item{z}{Real or complex number or a numeric or complex vector.} } \details{ Computes the Gamma function for complex arguments using the Lanczos series approximation. Accuracy is 15 significant digits along the real axis and 13 significant digits elsewhere. To compute the logarithmic Gamma function use \code{log(gammaz(z))}. } \value{ Returns a complex vector of function values. } \references{ Zhang, Sh., and J. Jin (1996). Computation of Special Functions. Wiley-Interscience, New York. } \note{ Copyright (c) 2001 Paul Godfrey for a Matlab version available on Mathwork's Matlab Central under BSD license. Numerical Recipes used a 7 terms formula for a less effective approximation. } \seealso{ \code{\link{gamma}}, \code{gsl::lngamma_complex} } \examples{ max(gamma(1:10) - gammaz(1:10)) gammaz(-1) gammaz(c(-2-2i, -1-1i, 0, 1+1i, 2+2i)) # Euler's reflection formula z <- 1+1i gammaz(1-z) * gammaz(z) # == pi/sin(pi*z) } \keyword{ specfun } pracma/man/integral2.Rd0000644000176200001440000001263712250325322014453 0ustar liggesusers\name{integral2} \alias{integral2} \alias{integral3} \title{ Numerically Evaluate Double and Triple Integrals } \description{ Numerically evaluate a double integral, resp. a triple integral by reducing it to a double integral. } \usage{ integral2(fun, xmin, xmax, ymin, ymax, sector = FALSE, reltol = 1e-6, abstol = 0, maxlist = 5000, singular = FALSE, vectorized = TRUE, ...) integral3(fun, xmin, xmax, ymin, ymax, zmin, zmax, reltol = 1e-6, ...) } \arguments{ \item{fun}{function} \item{xmin, xmax}{lower and upper limits of x.} \item{ymin, ymax}{lower and upper limits of y.} \item{zmin, zmax}{lower and upper limits of z.} \item{sector}{logical.} \item{reltol}{relative tolerance.} \item{abstol}{absolute tolerance.} \item{maxlist}{maximum length of the list of rectangles.} \item{singular}{logical; are there singularities at vertices.} \item{vectorized}{logical; is the function fully vectorized.} \item{...}{additional parameters to be passed to the function.} } \details{ \code{integral2} implements the `TwoD' algorithm, that is Gauss-Kronrod with (3, 7)-nodes on 2D rectangles. The borders of the domain of integration must be finite. The limits of \code{y}, that is \code{ymin} and \code{ymax}, can be constants or scalar functions of x that describe the lower and upper boundaries. These functions must be vectorized. \code{integral2} attempts to satisfy \code{ERRBND <= max(AbsTol,RelTol*|Q|)}. This is absolute error control when \code{|Q|} is sufficiently small and relative error control when \code{|Q|} is larger. The function \code{fun} itself must be fully vectorized: It must accept arrays \code{X} and \code{Y} and return an array \code{Z = f(X,Y)} of corresponding values. If option \code{vectorized} is set to \code{FALSE} the procedure will enforce this vectorized behavior. With \code{sector=TRUE} the region is a generalized sector that is described in polar coordinates (r,theta) by \code{0 <= a <= theta <= b} -- a and b must be constants\cr \code{c <= r <= d} -- c and d can be constants or ... ... functions of theta that describe the lower and upper boundaries. Functions must be vectorized.\cr NOTE Polar coordinates are used only to describe the region -- the integrand is \code{f(x,y)} for both kinds of regions. \code{integral2} can be applied to functions that are singular on a boundary. With value \code{singular=TRUE}, this option causes \code{integral2} to use transformations to weaken singularities for better performance. \code{integral3} also accepts functions for the inner interval limits. \code{ymin, ymax} must be constants or functions of one variable (\code{x}), \code{zmin, zmax} constants or functions of two variables (\code{x, y}), all functions vectorized. The triple integral will be first integrated over the second and third variable with \code{integral2}, and then integrated over a single variable with \code{integral}. } \value{ Returns a list with \code{Q} the integral and \code{error} the error term. } \references{ Shampine, L. F. (2008). MATLAB Program for Quadrature in 2D. Proceedings of Applied Mathematics and Computation, 2008, pp. 266--274. } \author{ Copyright (c) 2008 Lawrence F. Shampine for Matlab code and description of the program; adapted and converted to R by Hans W Borchers. } \note{ To avoid recursion, a possibly large matrix will be used and passed between subprograms. A more efficient implementation may be possible. } \seealso{ \code{\link{integral}}, \code{cubature:adaptIntegrate} } \examples{ fun <- function(x, y) cos(x) * cos(y) integral2(fun, 0, 1, 0, 1, reltol = 1e-10) # $Q: 0.708073418273571 # 0.70807341827357119350 = sin(1)^2 # $error: 8.618277e-19 # 1.110223e-16 ## Compute the volume of a sphere f <- function(x, y) sqrt(1 -x^2 - y^2) xmin <- 0; xmax <- 1 ymin <- 0; ymax <- function(x) sqrt(1 - x^2) I <- integral2(f, xmin, xmax, ymin, ymax) I$Q # 0.5236076 - pi/6 => 8.800354e-06 ## Compute the volume over a sector I <- integral2(f, 0,pi/2, 0,1, sector = TRUE) I$Q # 0.5236308 - pi/6 => 3.203768e-05 ## Integrate 1/( sqrt(x + y)*(1 + x + y)^2 ) over the triangle ## 0 <= x <= 1, 0 <= y <= 1 - x. The integrand is infinite at (0,0). f <- function(x,y) 1/( sqrt(x + y) * (1 + x + y)^2 ) ymax <- function(x) 1 - x I <- integral2(f, 0,1, 0,ymax) I$Q + 1/2 - pi/4 # -3.247091e-08 ## Compute this integral as a sector rmax <- function(theta) 1/(sin(theta) + cos(theta)) I <- integral2(f, 0,pi/2, 0,rmax, sector = TRUE, singular = TRUE) I$Q + 1/2 - pi/4 # -4.998646e-11 ## Examples of computing triple integrals f0 <- function(x, y, z) y*sin(x) + z*cos(x) integral3(f0, 0, pi, 0,1, -1,1) # - 2.0 => 0.0 f1 <- function(x, y, z) exp(x+y+z) integral3(f1, 0, 1, 1, 2, 0, 0.5) ## [1] 5.206447 # 5.20644655 f2 <- function(x, y, z) x^2 + y^2 + z a <- 2; b <- 4 ymin <- function(x) x - 1 ymax <- function(x) x + 6 zmin <- -2 zmax <- function(x, y) 4 + y^2 integral3(f2, a, b, ymin, ymax, zmin, zmax) ## [1] 47416.75556 # 47416.7555556 f3 <- function(x, y, z) sqrt(x^2 + y^2) a <- -2; b <- 2 ymin <- function(x) -sqrt(4-x^2) ymax <- function(x) sqrt(4-x^2) zmin <- function(x, y) sqrt(x^2 + y^2) zmax <- 2 integral3(f3, a, b, ymin, ymax, zmin, zmax) ## [1] 8.37758 # 8.377579076269617 } \keyword{ math } pracma/man/barylag2d.Rd0000644000176200001440000000466112042212424014426 0ustar liggesusers\name{barylag2d} \alias{barylag2d} \title{2-D Barycentric Lagrange Interpolation} \description{ Two-dimensional barycentric Lagrange interpolation. } \usage{ barylag2d(F, xn, yn, xf, yf) } \arguments{ \item{F}{matrix representing values of a function in two dimensions.} \item{xn, yn}{x- and y-coordinates of supporting nodes.} \item{xf, yf}{x- and y-coordinates of an interpolating grid..} } \details{ Well-known Lagrange interpolation using barycentric coordinates, here extended to two dimensions. The function is completely vectorized. x-coordinates run downwards in F, y-coordinates to the right. That conforms to the usage in image or contour plots, see the example below. } \value{ Matrix of size \code{length(xf)}-by-\code{length(yf)} giving the interpolated values at al the grid points \code{(xf, yf)}. } \references{ Berrut, J.-P., and L. Nick Trefethen (2004). ``Barycentric Lagrange Interpolation''. SIAM Review, Vol. 46(3), pp.501--517. } \note{ Copyright (c) 2004 Greg von Winckel of a Matlab function under BSD license; translation to R by Hans W Borchers with permission. } \seealso{ \code{\link{interp2}}, \code{\link{barylag}} } \examples{ ## Example from R-help xn <- c(4.05, 4.10, 4.15, 4.20, 4.25, 4.30, 4.35) yn <- c(60.0, 67.5, 75.0, 82.5, 90.0) foo <- matrix(c( -137.8379, -158.8240, -165.4389, -166.4026, -166.2593, -152.1720, -167.3145, -171.1368, -170.9200, -170.4605, -162.2264, -172.5862, -174.1460, -172.9923, -172.2861, -168.7746, -175.2218, -174.9667, -173.0803, -172.1853, -172.4453, -175.7163, -174.0223, -171.5739, -170.5384, -173.7736, -174.4891, -171.6713, -168.8025, -167.6662, -173.2124, -171.8940, -168.2149, -165.0431, -163.8390), nrow = 7, ncol = 5, byrow = TRUE) xf <- c(4.075, 4.1) yf <- c(63.75, 67.25) barylag2d(foo, xn, yn, xf, yf) # -156.7964 -163.1753 # -161.7495 -167.0424 # Find the minimum of the underlying function bar <- function(xy) barylag2d(foo, xn, yn, xy[1], xy[2]) optim(c(4.25, 67.5), bar) # "Nelder-Mead" # $par # 4.230547 68.522747 # $value # -175.7959 \dontrun{ # Image and contour plots image(xn, yn, foo) contour(xn, yn, foo, col="white", add = TRUE) xs <- seq(4.05, 4.35, length.out = 51) ys <- seq(60.0, 90.0, length.out = 51) zz <- barylag2d(foo, xn, yn, xs, ys) contour(xs, ys, zz, nlevels = 20, add = TRUE) contour(xs, ys, zz, levels=c(-175, -175.5), add = TRUE) points(4.23, 68.52)} } \keyword{ math } pracma/man/piecewise.Rd0000644000176200001440000000143712042212424014532 0ustar liggesusers\name{piecewise} \alias{piecewise} \title{ Piecewise Linear Function } \description{ Compute zeros and area of a piecewise linear function. } \usage{ piecewise(x, y, abs = FALSE) } \arguments{ \item{x, y}{x- and y-coordinates of points defining the piecewise linear function} \item{abs}{logical; shall the integral or the total area between the x-axis and the function be calculated} } \details{ Compute zeros and integral resp. area of a piecewise linear function given by points with x and y as coordinates. } \value{ Returns a list with the integral or area as first element and the vector as all zeroes as second. } \seealso{ \code{\link{trapz}} } \examples{ x <- c(0, 2, 3, 4, 5) y <- c(2, -2, 0, -2, 0) piecewise(x, y) piecewise(x, y, abs=TRUE) } \keyword{ math } pracma/man/newtonHorner.Rd0000644000176200001440000000275212042212424015246 0ustar liggesusers\name{newtonHorner} \alias{newtonHorner} \title{ Newton's Root Finding Method for Polynomials. } \description{ Finding roots of univariate polynomials. } \usage{ newtonHorner(p, x0, maxiter = 50, tol = .Machine$double.eps^0.5) } \arguments{ \item{p}{Numeric vector representing a polynomial.} \item{x0}{starting value for newtonHorner().} \item{maxiter}{maximum number of iterations; default 100.} \item{tol}{absolute tolerance; default \code{eps^(1/2)}} } \details{ Similar to \code{newtonRahson}, except that the computation of the derivative is done through the Horner scheme in parallel with computing the value of the polynomial. This makes the algorithm significantly faster. } \value{ Return a list with components \code{root}, \code{f.root}, the function value at the found root, \code{iter}, the number of iterations done, and \code{root}, and the estimated precision \code{estim.prec} The estimated precision is given as the difference to the last solution before stop. } \references{ Quarteroni, A., R. Sacco, and F. Saleri (2007). Numerical Mathematics. Second Edition, Springer-Verlag, Berlin Heidelberg. } \seealso{ \code{\link{newtonRaphson}} } \examples{ ## Example: x^3 - 6 x^2 + 11 x - 6 with roots 1, 2, 3 p <- c(1, -6, 11, -6) x0 <- 0 while (length(p) > 1) { N <- newtonHorner(p, x0) if (!is.null(N$root)) { cat("x0 =", N$root, "\n") p <- N$deflate } else { break } } ## Try: p <- Poly(c(1:20)) } \keyword{ math } pracma/man/strcat.Rd0000644000176200001440000000145611540452742014071 0ustar liggesusers\name{strcat} \alias{strcat} \title{String Concatenation} \description{ Concatenate all strings in a character vector } \usage{ strcat(s1, s2 = NULL, collapse = "") } \arguments{ \item{s1}{character string or vectors} \item{s2}{character string or vector, or NULL (default)} \item{collapse}{character vector of length 1 (at best a single character)} } \details{ Concatenate all strings in character vector \code{s1}, if \code{s2} is \code{NULL}, or cross-concatenate all string elements in \code{s1} and \code{s2} using \code{collapse} as `glue'. } \value{ a character string or character vector } \seealso{ \code{\link{paste}} } \examples{ strcat(c("a", "b", "c")) #=> "abc" strcat(c("a", "b"), c("1", "2"), collapse="x") #=> "ax1" "ax2" "bx1" "bx2" } \keyword{ string } pracma/man/quadl.Rd0000644000176200001440000000314512550243372013673 0ustar liggesusers\name{quadl} \alias{quadl} \title{ Adaptive Lobatto Quadrature } \description{ Adaptive quadrature of functions of one variable over a finite interval. } \usage{ quadl(f, xa, xb, tol = .Machine$double.eps^0.5, trace = FALSE, ...) } \arguments{ \item{f}{a one-dimensional function; needs to be vectorized.} \item{xa}{lower limit of integration; must be finite} \item{xb}{upper limit of integration; must be finite} \item{tol}{accuracy requested.} \item{trace}{logical; shall a trace be printed?} \item{\dots}{additional arguments to be passed to \code{f}.} } \details{ Realizes adaptive Lobatto quadrature in R through recursive calls. The function \code{f} needs to be vectorized though this could be changed easily. } \value{ A single numeric value, the computed integral. } \references{ Gander, W. and W. Gautschi (2000). ``Adaptive Quadrature --- Revisited''. BIT, Vol. 40, 2000, pp. 84-101. } \author{ Copyright (c) 1998 Walter Gautschi for the Matlab version published as part of the referenced article. R implementation by Hans W Borchers 2011. } \note{ Compared to Gaussian quadrature, Lobatto integration include the end points of the integration interval. It is accurate for polynomials up to degree 2n-3, where n is the number of integration points. } \seealso{ \code{\link{quad}} } \examples{ # options(digits=15) f <- function(x) x * cos(0.1*exp(x)) * sin(0.1*pi*exp(x)) quadl(f, 0, 4) # 1.2821290743501 integrate(f, 0, 4) # 1.28212907435010 with absolute error < 4.1e-06 \dontrun{ xx <- seq(0, 4, length.out = 200) yy <- f(xx) plot(xx, yy, type = 'l') grid()} } \keyword{ math } pracma/man/lebesgue.Rd0000644000176200001440000000213712042212424014346 0ustar liggesusers\name{lebesgue} \alias{lebesgue} \title{Lebesgue Constant} \description{ Estimates the Lebesgue constant. } \usage{ lebesgue(x, refine = 4, plotting = FALSE) } \arguments{ \item{x}{numeric vector of grid points} \item{refine}{refine the grid with \code{2^refine} grid points; can only be an integer between 2 and 10, default 4.} \item{plotting}{shall the Lebesgue function be plotted.} } \details{ The Lebesgue constant gives an estimation \eqn{||P_n f|| \le L ||f||} (in minimax norm) where \eqn{P_n f} is the interpolating polynomial of order \eqn{n} for \eqn{f} on an interval \eqn{[a, b]}. } \value{ Lebesgue constant for the given grid points. } \references{ Berrut, J.-P., and L. Nick Trefethen (2004). ``Barycentric Lagrange Interpolation''. SIAM Review, Vol. 46(3), pp.501--517. } \note{ The Lebesgue constant plays an important role when estimating the distance of interpolating polynomials from the minimax solution (see the Remez algorithm). } \seealso{ \code{\link{barylag}} } \examples{ lebesgue(seq(0, 1, length.out = 6)) #=> 3.100425 } \keyword{ math } pracma/man/householder.Rd0000644000176200001440000000237012042212424015073 0ustar liggesusers\name{householder} \alias{householder} \title{Householder Reflections} \description{ Householder reflections and QR decomposition } \usage{ householder(A) } \arguments{ \item{A}{numeric matrix with \code{nrow(A)>=ncol(A)}.} } \details{ The Householder method applies a succession of elementary unitary matrices to the left of matrix \code{A}. These matrices are the so-called Householder reflections. } \value{ List with two matrices \code{Q} and \code{R}, \code{Q} orthonormal and \code{R} upper triangular, such that \code{A=Q\%*\%R}. } \references{ Trefethen, L. N., and D. Bau III. (1997). Numerical Linear Algebra. SIAM, Society for Industrial and Applied Mathematics, Philadelphia. } \seealso{ \code{\link{givens}} } \examples{ ## QR decomposition A <- matrix(c(0,-4,2, 6,-3,-2, 8,1,-1), 3, 3, byrow=TRUE) S <- householder(A) (Q <- S$Q); (R <- S$R) Q \%*\% R # = A ## Solve an overdetermined linear system of equations A <- matrix(c(1:8,7,4,2,3,4,2,2), ncol=3, byrow=TRUE) S <- householder(A); Q <- S$Q; R <- S$R m <- nrow(A); n <- ncol(A) b <- rep(6, 5) x <- numeric(n) b <- t(Q) \%*\% b x[n] <- b[n] / R[n, n] for (k in (n-1):1) x[k] <- (b[k] - R[k, (k+1):n] \%*\% x[(k+1):n]) / R[k, k] qr.solve(A, rep(6, 5)); x } \keyword{ array } pracma/man/findzeros.Rd0000644000176200001440000000334212155035300014556 0ustar liggesusers\name{findzeros} \alias{findzeros} \title{ Find All Roots } \description{ Finding all roots of a unvariate function in an interval by splitting the interval in many small subintervals. } \usage{ findzeros(f, a, b, n = 100, tol = .Machine$double.eps^(2/3), ...) } \arguments{ \item{f}{functions whose roots shall be found.} \item{a, b}{endpoints of the interval.} \item{n}{number of subintervals to generate and search.} \item{tol}{tolerance for identifying zeros.} \item{\ldots}{Additional parameters to be passed to the function.} } \details{ Roots, i.e. zeros in a subinterval will be found by applying \code{uniroot} to any subinterval where the sign of the function changes. The endpoints of the interval will be tested separately. If the function points are both positive or negative and the slope in this interval is high enough, the minimum or maximum will be determined with \code{optimize} and checked for a possible zero. The function need not be vectorized. } \value{ Numeric vector with the x-positions of all roots found in the interval. } \seealso{ \code{\link{findmins}} } \examples{ f1 <- function(x) sin(pi/x) findzeros(f1, 1/10, 1) # 0.1000000 0.1111028 0.1250183 0.1428641 0.1666655 # 0.2000004 0.2499867 0.3333441 0.4999794 1.0000000 f2 <- function(x) 0.5*(1 + sin(10*pi*x)) findzeros(f2, 0, 1) # 0.15 0.35 0.55 0.75 0.95 f3 <- function(x) sin(pi/x) + 1 findzeros(f3, 0.1, 0.5) # 0.1052632 0.1333333 0.1818182 0.2857143 f4 <- function(x) sin(pi/x) - 1 findzeros(f4, 0.1, 0.5) # 0.1176471 0.1538462 0.2222222 0.4000000 \dontrun{ # Dini function Dini <- function(x) x * besselJ(x, 1) + 3 * besselJ(x, 0) findzeros(Dini, 0, 100, n = 128) ezplot(Dini, 0, 100, n = 512) } } \keyword{ math } pracma/man/mode.Rd0000644000176200001440000000173012001565513013502 0ustar liggesusers\name{Mode} \alias{Mode} \title{ Mode function (Matlab style) } \description{ Most frequent value in vector or matrix } \usage{ Mode(x) } \arguments{ \item{x}{Real or complex vector or of factor levels.} } \details{ Computes the `sample mode', i.e. the most frequently occurring value in x. Among values occurring equally frequently, \code{Mode()} chooses the smallest one (for a numeric vector), one with a smallest absolute value (for complex ones) or the first occurring value (for factor levels). A matrix will be changed to a vector. } \value{ One element from x and of the same type. The number of occurrences will not be returned. } \note{ In Matlab/Octave an array dimension can be selected along which to find the mode value; this has not been realized here. Shadows the R function \code{mode} that returns essentially the type of an object. } \seealso{ \code{\link{median}} } \examples{ x <- round(rnorm(1000), 2) Mode(x) } \keyword{ manip } pracma/man/std.Rd0000644000176200001440000000156211540452742013361 0ustar liggesusers\name{std} \alias{std} \title{Standard Deviation (Matlab Style)} \description{ Standard deviation of the values of \code{x}. } \usage{ std(x, flag=0) } \arguments{ \item{x}{numeric vector or matrix} \item{flag}{numeric scalar. If \code{0}, selects unbiased algorithm; and if \code{1}, selects the biased version.} } \details{ If \code{flag = 0} the result is the square root of an unbiased estimator of the variance. \code{std(X,1)} returns the standard deviation producing the second moment of the set of values about their mean. } \value{ Return value depends on argument \code{x}. If vector, returns the standard deviation. If matrix, returns vector containing the standard deviation of each column. } \note{ \code{flag = 0} produces the same result as R's sd(). } \examples{ std(1:10) # 3.027650 std(1:10, flag=1) # 2.872281 } \keyword{ stat } pracma/man/spinterp.Rd0000644000176200001440000000640712042212424014423 0ustar liggesusers\name{spinterp} \alias{spinterp} \title{ Monotone (Shape-Preserving) Interpolation } \description{ Monotone interpolation preserves the monotonicity of the data being interpolated, and when the data points are also monotonic, the slopes of the interpolant should also be monotonic. } \usage{ spinterp(x, y, xp) } \arguments{ \item{x, y}{x- and y-coordinates of the points that shall be interpolated.} \item{xp}{points that should be interpolated.} } \details{ This implementation follows a cubic version of the method of Delbourgo and Gregory. It yields `shaplier' curves than the Stineman method. The calculation of the slopes is according to recommended practice: - monotonic and convex --> harmonic\cr - monotonic and nonconvex --> geometric\cr - nonmonotonic and convex --> arithmetic\cr - nonmonotonic and nonconvex --> circles (Stineman) [not implemented] The choice of supplementary coefficients \code{r[i]} depends on whether the data are montonic or convex or both: - monotonic, but not convex\cr - otherwise and that can be detected from the data. The choice \code{r[i]=3} for all \code{i} results in the standard cubic Hermitean rational interpolation. } \value{ The interpolated values at all the points of \code{xp}. } \references{ Stan Wagon (2010). Mathematica in Action. Third Edition, Springer-Verlag. } \note{ At the moment, the data need to be monotonic and the case of convexity is not considered. } \seealso{ \code{stinepack::stinterp}, \code{demography::cm.interp} } \examples{ data1 <- list(x = c(1,2,3,5,6,8,9,11,12,14,15), y = c(rep(10,6), 10.5,15,50,60,95)) data2 <- list(x = c(0,1,4,6.5,9,10), y = c(10,4,2,1,3,10)) data3 <- list(x = c(7.99,8.09,8.19,8.7,9.2,10,12,15,20), y = c(0,0.000027629,0.00437498,0.169183,0.469428, 0.94374,0.998636,0.999919,0.999994)) data4 <- list(x = c(22,22.5,22.6,22.7,22.8,22.9, 23,23.1,23.2,23.3,23.4,23.5,24), y = c(523,543,550,557,565,575, 590,620,860,915,944,958,986)) data5 <- list(x = c(0,1.1,1.31,2.5,3.9,4.4,5.5,6,8,10.1), y = c(10.1,8,4.7,4.0,3.48,3.3,5.8,7,7.7,8.6)) data6 <- list(x = c(-0.8, -0.75, -0.3, 0.2, 0.5), y = c(-0.9, 0.3, 0.4, 0.5, 0.6)) data7 <- list(x = c(-1, -0.96, -0.88, -0.62, 0.13, 1), y = c(-1, -0.4, 0.3, 0.78, 0.91, 1)) data8 <- list(x = c(-1, -2/3, -1/3, 0.0, 1/3, 2/3, 1), y = c(-1, -(2/3)^3, -(1/3)^3, -(1/3)^3, (1/3)^3, (1/3)^3, 1)) \dontrun{ opr <- par(mfrow=c(2,2)) # These are well-known test cases: D <- data1 plot(D, ylim=c(0, 100)); grid() xp <- seq(1, 15, len=51); yp <- spinterp(D$x, D$y, xp) lines(spline(D), col="blue") lines(xp, yp, col="red") D <- data3 plot(D, ylim=c(0, 1.2)); grid() xp <- seq(8, 20, len=51); yp <- spinterp(D$x, D$y, xp) lines(spline(D), col="blue") lines(xp, yp, col="red") D <- data4 plot(D); grid() xp <- seq(22, 24, len=51); yp <- spinterp(D$x, D$y, xp) lines(spline(D), col="blue") lines(xp, yp, col="red") # Fix a horizontal slope at the end points D <- data8 x <- c(-1.05, D$x, 1.05); y <- c(-1, D$y, 1) plot(D); grid() xp <- seq(-1, 1, len=101); yp <- spinterp(x, y, xp) lines(spline(D, n=101), col="blue") lines(xp, yp, col="red") par(opr)} } \keyword{ math } pracma/man/fmincon.Rd0000644000176200001440000000474313400317701014214 0ustar liggesusers\name{fmincon} \alias{fmincon} \title{ Minimize Nonlinear Constrained Multivariable Function. } \description{ Find minimum of multivariable functions with nonlinear constraints. } \usage{ fmincon(x0, fn, gr = NULL, ..., method = "SQP", A = NULL, b = NULL, Aeq = NULL, beq = NULL, lb = NULL, ub = NULL, hin = NULL, heq = NULL, tol = 1e-06, maxfeval = 10000, maxiter = 5000) } \arguments{ \item{x0}{starting point.} \item{fn}{objective function to be minimized.} \item{gr}{gradient function of the objective; not used for SQP method.} \item{...}{additional parameters to be passed to the function.} \item{method}{method options 'SQP', 'auglag'; only 'SQP is implemented.} \item{A, b}{linear ineqality constraints of the form A x <= b .} \item{Aeq, beq}{linear eqality constraints of the form Aeq x = beq .} \item{lb, ub}{bounds constraints of the form lb <= x <= ub .} \item{hin}{nonlinear inequality constraints of the form hin(x) <= 0 .} \item{heq}{nonlinear equality constraints of the form heq(x) = 0 .} \item{tol}{relative tolerance.} \item{maxiter}{maximum number of iterations.} \item{maxfeval}{maximum number of function evaluations.} } \details{ Wraps the function \code{solnl} in the 'NlcOptim' package. The underlying method is a Squential Quadratic Programming (SQP) approach. Constraints can be defined in different ways, as linear constraints in matrix form, as nonlinear functions, or as bounds constraints. } \value{ List with the following components: \item{par}{the best minimum found.} \item{value}{function value at the minimum.} \item{convergence}{integer indicating the terminating situation.} \item{info}{parameter list describing the final situation.} } \references{ J. Nocedal and S. J. Wright (2006). Numerical Optimization. Second Edition, Springer Science+Business Media, New York. } \note{ \code{fmincon} mimics the Matlab function of the same name. } \author{ Xianyan Chen for the package NlcOptim. } \seealso{ \code{\link{fminsearch}}, \code{\link{fminunc}}, } \examples{ # Classical Rosenbrock function n <- 10; x0 <- rep(1/n, n) fn <- function(x) {n <- length(x) x1 <- x[2:n]; x2 <- x[1:(n - 1)] sum(100 * (x1 - x2^2)^2 + (1 - x2)^2) } # Equality and inequality constraints heq1 <- function(x) sum(x)-1.0 hin1 <- function(x) -1 * x hin2 <- function(x) x - 0.5 ub <- rep(0.5, n) # Apply constraint minimization res <- fmincon(x0, fn, hin = hin1, heq = heq1) res$par; res$value } \keyword{ optimize } pracma/man/laguerre.Rd0000644000176200001440000000216511567515665014412 0ustar liggesusers\name{laguerre} \alias{laguerre} \title{ Laguerre's Method } \description{ Laguerre's method for finding roots of complex polynomials. } \usage{ laguerre(p, x0, nmax = 25, tol = .Machine$double.eps^(1/2)) } \arguments{ \item{p}{real or complex vector representing a polynomial.} \item{x0}{real or complex point near the root.} \item{nmax}{maximum number of iterations.} \item{tol}{absolute tolerance.} } \details{ Uses values of the polynomial and its first and second derivative. } \value{ The root found, or a warning about the number of iterations. } \references{ Fausett, L. V. (2007). Applied Numerical Analysis Using Matlab. Second edition, Prentice Hall. } \note{ Computations are caried out in complex arithmetic, and it is possible to obtain a complex root even if the starting estimate is real. } \seealso{ \code{\link{roots}} } \examples{ # 1 x^5 - 5.4 x^4 + 14.45 x^3 - 32.292 x^2 + 47.25 x - 26.46 p <- c(1.0, -5.4, 14.45, -32.292, 47.25, -26.46) laguerre(p, 1) #=> 1.2 laguerre(p, 2) #=> 2.099987 (should be 2.1) laguerre(p, 2i) #=> 0+2.236068i (+- 2.2361i, i.e sqrt(-5)) } \keyword{ math } pracma/man/quadcc.Rd0000644000176200001440000000155612122020377014022 0ustar liggesusers\name{quadcc} \alias{quadcc} \title{ Adaptive Clenshaw-Curtis Quadrature } \description{ Adaptive Clenshaw-Curtis Quadrature. } \usage{ quadcc(f, a, b, tol = .Machine$double.eps^0.5, ...) } \arguments{ \item{f}{integrand as function, may have singularities at the endpoints.} \item{a, b}{endpoints of the integration interval.} \item{tol}{relative tolerence.} \item{\ldots}{Additional parameters to be passed to the function \code{f}.} } \details{ Adaptive version of the Clenshaw-Curtis quadrature formula with an (4, 8)-point erroe term. } \value{ List with two components, \code{value} the value of the integral and the relative error \code{error}. } \seealso{ \code{clenshaw_curtis} } \examples{ \dontrun{ ## Dilogarithm function flog <- function(t) log(1-t)/t quadcc(flog, 1, 0, tol = 1e-12) # 1.644934066848128 - pi^2/6 < 1e-13 } } \keyword{ math } pracma/man/combs.Rd0000644000176200001440000000110011542722330013651 0ustar liggesusers\name{combs} \alias{combs} \title{ Generate Combinations } \description{ Generates all combinations of length \code{m} of a vector \code{a}. } \usage{ combs(a, m) } \arguments{ \item{a}{numeric vector of some length \code{n}} \item{m}{integer with \code{0 <= m <= n}} } \details{ \code{combs} generates combinations of length \code{n} of the elements of the vector \code{a}. } \value{ matrix representing combinations of the elements of \code{a} } \seealso{ \code{\link{perms}}, \code{\link{randcomb}} } \examples{ combs(seq(2, 10, by=2), m = 3) } \keyword{ arith } pracma/man/bernstein.Rd0000644000176200001440000000352613121271145014553 0ustar liggesusers\name{bernstein} \alias{bernstein} \alias{bernsteinb} \title{ Bernstein Polynomials } \description{ Bernstein base polynomials and approximations. } \usage{ bernstein(f, n, x) bernsteinb(k, n, x) } \arguments{ \item{f}{function to be approximated by Bernstein polynomials.} \item{k}{integer between 0 and n, the k-th Bernstein polynomial of order n.} \item{n}{order of the Bernstein polynomial(s).} \item{x}{numeric scalar or vector where the Bernstein polynomials will be calculated.} } \details{ The Bernstein basis polynomials \eqn{B_{k,n}(x)} are defined as \deqn{ B_{k,n}(x) = {{n}\choose{k}} x^k (1-x)^{n-k} } and form a basis for the vector space of polynomials of degree \eqn{n} over the interval \eqn{[0,1]}. \code{bernstein(f, n, x)} computes the approximation of function \code{f} through Bernstein polynomials of degree \code{n}, resp. computes the value of this approximation at \code{x}. The function is vectorized and applies a brute force calculation. But if \code{x} is a scalar, the value will be calculated using De Casteljau's algorithm for higher accuracy. For bigger \code{n} the binomial coefficients may be in for problems. } \value{ Returns a scalar or vector of function values. } \references{ See https://en.wikipedia.org/wiki/Bernstein_polynomial } \examples{ ## Example f <- function(x) sin(2*pi*x) xs <- linspace(0, 1) ys <- f(xs) \dontrun{ plot(xs, ys, type='l', col="blue", main="Bernstein Polynomials") grid() b10 <- bernstein(f, 10, xs) b100 <- bernstein(f, 100, xs) lines(xs, b10, col="magenta") lines(xs, b100, col="red") } # Bernstein basis polynomials \dontrun{ xs <- linspace(0, 1) plot(c(0,1), c(0,1), type='n', main="Bernstein Basis Polynomials") grid() n = 10 for (i in 0:n) { bs <- bernsteinb(i, n, xs) lines(xs, bs, col=i+1) } } } \keyword{ math } pracma/man/flipdim.Rd0000644000176200001440000000175611676072775014236 0ustar liggesusers\name{flipdim} \alias{flipdim} \alias{flipud} \alias{fliplr} \alias{circshift} \title{Matrix Flipping (Matlab Style)} \description{ Flip matrices up and down or left and right; or circulating indices per dimension. } \usage{ flipdim(a, dim) flipud(a) fliplr(a) circshift(a, sz) } \arguments{ \item{a}{numeric or complex matrix} \item{dim}{flipping dimension; can only be 1 (default) or 2} \item{sz}{integer vector of length 1 or 2.} } \details{ \code{flipdim} will flip a matrix along the \code{dim} dimension, where \code{dim=1} means flipping rows, and \code{dim=2} flipping the columns. \code{flipud} and \code{fliplr} are simply shortcuts for \code{flipdim(a, 1)} resp. \code{flipdim(a, 2)}. \code{circshift(a, sz)} circulates each dimension (should be applicable to arrays). } \value{ the original matrix somehow flipped or circularly shifted. } \examples{ a <- matrix(1:12, nrow=3, ncol=4, byrow=TRUE) flipud(a) fliplr(a) circshift(a, c(1, -1)) v <- 1:10 circshift(v, 5) } \keyword{ manip } pracma/man/refindall.Rd0000644000176200001440000000206711653251250014524 0ustar liggesusers\name{refindall} \alias{refindall} \title{ Find overlapping regular expression matches. } \description{ Find overlapping matches for a regular expression. } \usage{ refindall(s, pat, over = 1, ignorecase = FALSE) } \arguments{ \item{s}{Single character string.} \item{pat}{Regular expression.} \item{over}{Natural number, indication how many steps to go forward after a match; defaults to 1.} \item{ignorecase}{logical, whether to ignore case.} } \details{ Returns the starting position of all --- even overlapping --- matches of the regular expression \code{pat} in the character string \code{s}. The syntax for pattern matching has to be PERL-like. } \value{ A numeric vector with the indices of starting positions of all matches. } \note{ This effect can also be reached with the R function gregexpr(), see the example below. } \seealso{ \code{\link{regexp}} } \examples{ refindall("ababababa", 'aba') gregexpr('a(?=ba)', "ababababa", perl=TRUE) refindall("AbababaBa", 'aba') refindall("AbababaBa", 'aba', ignorecase = TRUE) } \keyword{ string } pracma/man/quad.Rd0000644000176200001440000000326412550243372013521 0ustar liggesusers\name{quad} \alias{quad} \title{ Adaptive Simpson Quadrature } \description{ Adaptive quadrature of functions of one variable over a finite interval. } \usage{ quad(f, xa, xb, tol = .Machine$double.eps^0.5, trace = FALSE, ...) } \arguments{ \item{f}{a one-dimensional function; needs to be vectorized.} \item{xa}{lower limit of integration; must be finite} \item{xb}{upper limit of integration; must be finite} \item{tol}{accuracy requested.} \item{trace}{logical; shall a trace be printed?} \item{\dots}{additional arguments to be passed to \code{f}.} } \details{ Realizes adaptive Simpson quadrature in R through recursive calls. The function \code{f} needs to be vectorized though this could be changed easily. \code{quad} is not suitable for functions with singularities in the interval or at end points. } \value{ A single numeric value, the computed integral. } \references{ Gander, W. and W. Gautschi (2000). ``Adaptive Quadrature --- Revisited''. BIT, Vol. 40, 2000, pp. 84-101. } \author{ Copyright (c) 1998 Walter Gautschi for the Matlab version published as part of the referenced article. R implementation by Hans W Borchers 2011. } \note{ More modern adaptive methods based on Gauss-Kronrod or Clenshaw-Curtis quadrature are now generally preferred. } \seealso{ \code{\link{integrate}}, \code{\link{quadl}} } \examples{ # options(digits=15) f <- function(x) x * cos(0.1*exp(x)) * sin(0.1*pi*exp(x)) quad(f, 0, 4) # 1.2821290747821 quad(f, 0, 4, tol=10^-15) # 1.2821290743501 integrate(f, 0, 4) # 1.28212907435010 with absolute error < 4.1e-06 \dontrun{ xx <- seq(0, 4, length.out = 200) yy <- f(xx) plot(xx, yy, type = 'l') grid()} } \keyword{ math } pracma/man/repmat.Rd0000644000176200001440000000131112062032441014035 0ustar liggesusers\name{repmat} \alias{repmat} \title{Replicate Matrix} \description{ Replicate and tile matrix. } \usage{ repmat(a, n, m = n) } \arguments{ \item{a}{vector or matrix to be replicated.} \item{n, m}{number of times to replicate in each dimension.} } \details{ \code{repmat(a,m,n)} creates a large matrix consisting of an m-by-n tiling of copies of \code{a}. } \value{ Returns matrix with value \code{a} replicated to the number of times in each dimension specified. Defaults to square if dimension argument resolves to a single value. } \seealso{ \code{\link{Reshape}} } \examples{ repmat(1, 3) # same as ones(3) repmat(1, 3, 3) repmat(matrix(1:4, 2, 2), 3) } \keyword{array} pracma/man/ceil.Rd0000644000176200001440000000155612031004636013475 0ustar liggesusers\name{ceil} \alias{ceil} \alias{Fix} \title{Integer Functions (Matlab Style)} \description{ Functions for rounding and truncating numeric values towards near integer values. } \usage{ ceil(n) Fix(n) } \arguments{ \item{n}{a numeric vector or matrix} } \details{ \code{ceil()} is an alias for \code{ceiling()} and rounds to the smallest integer equal to or above \code{n}. \code{Fix()} truncates values towards 0 and is an alias for \code{trunc()}. Uses \code{ml} prefix to indicate Matlab style. The corresponding functions \code{floor()} (rounding to the largest interger equal to or smaller than \code{n}) and \code{round()} (rounding to the specified number of digits after the decimal point, default being 0) are already part of R base. } \value{ integer values } \examples{ x <- c(-1.2, -0.8, 0, 0.5, 1.1, 2.9) ceil(x) Fix(x) } \keyword{ arith } pracma/man/newmark.Rd0000644000176200001440000000521712031327377014235 0ustar liggesusers\name{newmark} \alias{newmark} \title{ Newmark Method } \description{ Newmark's is a method to solve higher-order differential equations without passing through the equivalent first-order system. It generalizes the so-called `leap-frog' method. Here it is restricted to second-order equations. } \usage{ newmark(f, t0, t1, y0, ..., N = 100, zeta = 0.25, theta = 0.5) } \arguments{ \item{f}{function in the differential equation \eqn{y'' = f(x, y, y')};\cr defined as a function \eqn{R \times R^2 \rightarrow R}.} \item{t0, t1}{start and end points of the interval.} \item{y0}{starting values as row or column vector; \code{y0} needs to be a vector of length 2, the first component representing \code{y(t0)}, the second \code{dy/dt(t0)}.} \item{N}{number of steps.} \item{zeta, theta}{two non-negative real numbers.} \item{...}{Additional parameters to be passed to the function.} } \details{ Solves second order differential equations using the Newmark method on an equispaced grid of \code{N} steps. Function \code{f} must return a vector, whose elements hold the evaluation of \code{f(t,y)}, of the same dimension as \code{y0}. Each row in the solution array Y corresponds to a time returned in \code{t}. The method is `implicit' unless \code{zeta=theta=0}, second order if \code{theta=1/2} and first order accurate if \code{theta!=1/2}. \code{theta>=1/2} ensures stability. The condition set \code{theta=1/2; zeta=1/4} (the defaults) is a popular approach that is unconditionally stable, but introduces oscillatory spurious solutions on long time intervals. (For these simulations it is preferable to use \code{theta>1/2} and \code{zeta>(theta+1/2)^(1/2)}.) No attempt is made to catch any errors in the root finding functions. } \value{ List with components \code{t} for grid (or `time') points between \code{t0} and \code{t1}, and \code{y} an n-by-2 matrix with solution variables in columns, i.e. each row contains one time stamp. } \references{ Quarteroni, A., R. Sacco, and F. Saleri (2007). Numerical Mathematics. Second Edition, Springer-Verlag, Berlin Heidelberg. } \note{ This is for demonstration purposes only; for real problems or applications please use \code{ode23} or \code{rk4sys}. } \seealso{ \code{\link{ode23}}, \code{\link{cranknic}} } \examples{ # Mathematical pendulum m l y'' + m g sin(y) = 0 pendel <- function(t, y) -sin(y[1]) sol <- newmark(pendel, 0, 4*pi, c(pi/4, 0)) \dontrun{ plot(sol$t, sol$y[, 1], type="l", col="blue", xlab="Time", ylab="Elongation/Speed", main="Mathematical Pendulum") lines(sol$t, sol$y[, 2], col="darkgreen") grid()} } \keyword{ ode } pracma/man/pracma-package.Rd0000644000176200001440000002047214002617413015416 0ustar liggesusers\name{pracma-package} \alias{pracma-package} \alias{pracma} \docType{package} \title{ Practical Numerical Math Routines } \description{ This package provides R implementations of more advanced functions in numerical analysis, with a special view on on optimization and time series routines. Uses Matlab/Octave function names where appropriate to simplify porting. Some of these implementations are the result of courses on Scientific Computing (``Wissenschaftliches Rechnen'') and are mostly intended to demonstrate how to implement certain algorithms in R/S. Others are implementations of algorithms found in textbooks. } \details{ The package encompasses functions from all areas of numerical analysis, for example: \itemize{ \item Root finding and minimization of univariate functions,\cr e.g. Newton-Raphson, Brent-Dekker, Fibonacci or `golden ratio' search. \item Handling polynomials, including roots and polynomial fitting,\cr e.g. Laguerre's and Muller's methods. \item Interpolation and function approximation,\cr barycentric Lagrange interpolation, Pade and rational interpolation, Chebyshev or trigonometric approximation. \item Some special functions,\cr e.g. Fresnel integrals, Riemann's Zeta or the complex Gamma function, and Lambert's W computed iteratively through Newton's method. \item Special matrices, e.g. Hankel, Rosser, Wilkinson \item Numerical differentiation and integration,\cr Richardson approach and ``complex step'' derivatives, adaptive Simpson and Lobatto integration and adaptive Gauss-Kronrod quadrature. \item Solvers for ordinary differential equations and systems,\cr Euler-Heun, classical Runge-Kutta, ode23, or predictor-corrector method such as the Adams-Bashford-Moulton. \item Some functions from number theory,\cr such as primes and prime factorization, extended Euclidean algorithm. \item Sorting routines, e.g. recursive quickstep. \item Several functions for string manipulation and regular search, all wrapped and named similar to their Matlab analogues. } It serves three main goals: \itemize{ \item Collecting R scripts that can be demonstrated in courses on `Numerical Analysis' or `Scientific Computing' using R/S as the chosen programming language. \item Wrapping functions with appropriate Matlab names to simplify porting programs from Matlab or Octave to R. \item Providing an environment in which R can be used as a full-blown numerical computing system. } Besides that, many of these functions could be called in R applications as they do not have comparable counterparts in other R packages (at least at this moment, as far as I know). All referenced books have been utilized in one way or another. Web links have been provided where reasonable. } \note{ The following 220 functions are emulations of correspondingly named Matlab functions and bear the same signature as their Matlab cousins if possible: \code{accumarray, acosd, acot, acotd, acoth, acsc, acscd, acsch, and, angle, ans,}\cr \code{ arrayfun, asec, asecd, asech, asind, atand, atan2d,}\cr \code{beep, bernoulli, blank, blkdiag, bsxfun,}\cr \code{cart2pol, cart2sph, cd, ceil, circshift, clear, compan, cond, conv,}\cr \code{ cosd, cot, cotd, coth, cross, csc, cscd, csch, cumtrapz,}\cr \code{dblquad, deblank, deconv, deg2rad, detrend, deval, disp, dot,}\cr \code{eig, eigint, ellipj, ellipke, eps, erf, erfc, erfcinv, erfcx, erfi, erfinv,}\cr \code{ errorbar, expint, expm, eye, ezcontour, ezmesh, ezplot, ezpolar, ezsurf,}\cr \code{fact, fftshift, figure, findpeaks, findstr, flipdim, fliplr, flipud,}\cr \code{ fminbnd, fmincon, fminsearch, fminunc, fplot, fprintf, fsolve, fzero,}\cr \code{gammainc, gcd, geomean, gmres, gradient,}\cr \code{hadamard, hankel, harmmean, hilb, histc, humps, hypot,}\cr \code{idivide, ifft, ifftshift, inpolygon, integral, integral2, integral3,}\cr \code{ interp1, interp2, inv, isempty, isprime,}\cr \code{kron,}\cr \code{legendre, linprog, linspace, loglog, logm, logseq, logspace, lsqcurvefit,}\cr \code{ lsqlin, lsqnonlin, lsqnonneg, lu,}\cr \code{magic, meshgrid, mkpp, mldivide, mod, mrdivide,}\cr \code{nchoosek, ndims, nextpow2, nnz, normest, nthroot, null, num2str, numel,}\cr \code{ode23, ode23s, ones, or, orth,}\cr \code{pascal, pchip, pdist, pdist2, peaks, perms, piecewise, pinv, plotyy,}\cr \code{ pol2cart, polar, polyfit, polyint, polylog, polyval, pow2, ppval,}\cr \code{ primes, psi, pwd,}\cr \code{quad, quad2d, quadgk, quadl, quadprog, quadv, quiver,}\cr \code{rad2deg, randi, randn, randsample, rat, rats, regexp, regexpi,}\cr \code{ regexpreg, rem, repmat, roots, rosser, rot90, rref, runge,}\cr \code{sec, secd, sech, semilogx, semilogy, sinc, sind, size, sortrows, sph2cart,}\cr \code{ sqrtm, squareform, std, str2num, strcat, strcmp, strcmpi,}\cr \code{ strfind, strfindi, strjust, subspace,}\cr \code{tand, tic, toc, trapz, tril, trimmean, triplequad, triu,}\cr \code{vander, vectorfield, ver,}\cr \code{what, who, whos, wilkinson,}\cr \code{zeros, zeta} The following Matlab function names have been capitalized in `pracma' to avoid shadowing functions from R base or one of its recommended packages (on request of Bill Venables and because of Brian Ripley's CRAN policies): \code{Diag, factos, finds, Fix, Imag, Lcm, Mode, Norm, nullspace (<- null)},\cr \code{Poly, Rank, Real, Reshape, strRep, strTrim, Toeplitz, Trace, uniq (<- unique).} To use ``ans'' instead of ``ans()'' -- as is common practice in Matlab -- type (and similar for other Matlab commands): \code{makeActiveBinding("ans", function() .Last.value, .GlobalEnv)}\cr \code{makeActiveBinding("who", who(), .GlobalEnv)} } \author{ Hans Werner Borchers Maintainer: Hans W Borchers } \references{ Abramowitz, M., and I. A. Stegun (1972). Handbook of Mathematical Functions (with Formulas, Graphs, and Mathematical Tables). Dover, New York. URL: https://www.math.ubc.ca/~cbm/aands/notes.htm Arndt, J. (2010). Matters Computational: Ideas, Algorithms, Source Code. Springer-Verlag, Berlin Heidelberg Dordrecht. FXT: a library of algorithms: \url{https://www.jjj.de/fxt/}. Cormen, Th. H., Ch. E. Leiserson, and R. L. Rivest (2009). Introduction to Algorithms. Third Edition, The MIT Press, Cambridge, MA. Encyclopedia of Mathematics (2012). Editor-in-Chief: Ulf Rehmann. \url{https://encyclopediaofmath.org/wiki/Main_Page}. Gautschi, W. (1997). Numerical Analysis: An Introduction. Birkhaeuser, Boston. Gentle, J. E. (2009). Computational Statistics. Springer Science+Business Media LCC, New York. MathWorld.com (2011). Matlab Central: \url{https://www.mathworks.com/matlabcentral/}. NIST: National Institute of Standards and Technology. Olver, F. W. J., et al. (2010). NIST Handbook of Mathematical Functions. Cambridge University Press. Internet: NIST Digital Library of Mathematical Functions, \url{https://dlmf.nist.gov/}; Guide to Available Mathematical Software, \url{https://gams.nist.gov/}. Press, W. H., S. A. Teukolsky, W. T Vetterling, and B. P. Flannery (2007). Numerical Recipes: The Art of Numerical Computing. Third Edition, incl. Numerical Recipes Software, Cambridge University Press, New York. URL: numerical.recipes/book/book.html. Quarteroni, A., R. Sacco, and F. Saleri (2007). Numerical Mathematics. Second Edition, Springer-Verlag, Berlin Heidelberg. Skiena, St. S. (2008). The Algorithm Design Manual. Second Edition, Springer-Verlag, London. The Stony Brook Algorithm Repository: \url{https://algorist.com/algorist.html}. Stoer, J., and R. Bulirsch (2002). Introduction to Numerical Analysis. Third Edition, Springer-Verlag, New York. Strang, G. (2007). Computational Science and Engineering. Wellesley-Cambridge Press. Weisstein, E. W. (2003). CRC Concise Encyclopedia of Mathematics. Second Edition, Chapman & Hall/CRC Press. Wolfram MathWorld: \url{https://mathworld.wolfram.com/}. Zhang, S., and J. Jin (1996). Computation of Special Functions. John Wiley & Sons. } \seealso{ The R package `matlab' contains some of the basic routines from Matlab, but unfortunately not any of the higher math routines. } \examples{ \dontrun{ ## See examples in the help files for all functions. } } \keyword{ package } pracma/man/primes.Rd0000644000176200001440000000354012042212424014051 0ustar liggesusers\name{primes} \alias{primes} \title{Prime Numbers} \description{ Generate a list of prime numbers less or equal \code{n}, resp. between \code{n1} and \code{n2}. } \usage{ primes(n) } \arguments{ \item{n}{nonnegative integer greater than 1.} } \details{ The list of prime numbers up to \code{n} is generated using the "sieve of Erasthostenes". This approach is reasonably fast, but may require a lot of main memory when \code{n} is large. In double precision arithmetic integers are represented exactly only up to 2^53 - 1, therefore this is the maximal allowed value. } \value{ vector of integers representing prime numbers } \seealso{ \code{\link{isprime}, \link{factors}} } \examples{ primes(1000) \dontrun{ ## Appendix: Logarithmic Integrals and Prime Numbers (C.F.Gauss, 1846) library('gsl') # 'European' form of the logarithmic integral Li <- function(x) expint_Ei(log(x)) - expint_Ei(log(2)) # No. of primes and logarithmic integral for 10^i, i=1..12 i <- 1:12; N <- 10^i # piN <- numeric(12) # for (i in 1:12) piN[i] <- length(primes(10^i)) piN <- c(4, 25, 168, 1229, 9592, 78498, 664579, 5761455, 50847534, 455052511, 4118054813, 37607912018) cbind(i, piN, round(Li(N)), round((Li(N)-piN)/piN, 6)) # i pi(10^i) Li(10^i) rel.err # -------------------------------------- # 1 4 5 0.280109 # 2 25 29 0.163239 # 3 168 177 0.050979 # 4 1229 1245 0.013094 # 5 9592 9629 0.003833 # 6 78498 78627 0.001637 # 7 664579 664917 0.000509 # 8 5761455 5762208 0.000131 # 9 50847534 50849234 0.000033 # 10 455052511 455055614 0.000007 # 11 4118054813 4118066400 0.000003 # 12 37607912018 37607950280 0.000001 # --------------------------------------} } \keyword{ arith } pracma/man/gramschmidt.Rd0000644000176200001440000000211312042212424015047 0ustar liggesusers\name{gramSchmidt} \alias{gramSchmidt} \title{Gram-Schmidt} \description{ Modified Gram-Schmidt Process } \usage{ gramSchmidt(A, tol = .Machine$double.eps^0.5) } \arguments{ \item{A}{numeric matrix with \code{nrow(A)>=ncol(A)}.} \item{tol}{numerical tolerance for being equal to zero.} } \details{ The modified Gram-Schmidt process uses the classical orthogonalization process to generate step by step an orthonoral basis of a vector space. The modified Gram-Schmidt iteration uses orthogonal projectors in order ro make the process numerically more stable. } \value{ List with two matrices \code{Q} and \code{R}, \code{Q} orthonormal and \code{R} upper triangular, such that \code{A=Q\%*\%R}. } \references{ Trefethen, L. N., and D. Bau III. (1997). Numerical Linear Algebra. SIAM, Society for Industrial and Applied Mathematics, Philadelphia. } \seealso{ \code{\link{householder}, \link{givens}} } \examples{ ## QR decomposition A <- matrix(c(0,-4,2, 6,-3,-2, 8,1,-1), 3, 3, byrow=TRUE) gs <- gramSchmidt(A) (Q <- gs$Q); (R <- gs$R) Q \%*\% R # = A } \keyword{ array } pracma/man/eye.Rd0000644000176200001440000000102612001517521013332 0ustar liggesusers\name{eye} \alias{eye} \alias{ones} \alias{zeros} \title{Some Basic Matrices} \description{ Create basic matrices. } \usage{ eye(n, m = n) ones(n, m = n) zeros(n, m = n) } \arguments{ \item{m, n}{numeric scalars specifying size of the matrix} } \value{ Matrix of size \code{n x m}. Defaults to a square matrix if \code{m} is missing. No dropping of dimensions; if \code{n = 1}, still returns a matrix and not a vector. } \seealso{ \code{\link{Diag}}, } \examples{ eye(3) ones(3, 1) zeros(1, 3) } \keyword{ array } pracma/man/sqrtm.Rd0000644000176200001440000001055612042212424013725 0ustar liggesusers\name{sqrtm,rootm} \alias{sqrtm} \alias{signm} \alias{rootm} \title{ Matrix Square and p-th Roots } \description{ Computes the matrix square root and matrix p-th root of a nonsingular real matrix. } \usage{ sqrtm(A, kmax = 20, tol = .Machine$double.eps^(1/2)) signm(A, kmax = 20, tol = .Machine$double.eps^(1/2)) rootm(A, p, kmax = 20, tol = .Machine$double.eps^(1/2)) } \arguments{ \item{A}{numeric, i.e. real, matrix.} \item{p}{p-th root to be taken.} \item{kmax}{maximum number of iterations.} \item{tol}{absolut tolerance, norm distance of \code{A} and \code{B^p}.} } \details{ A real matrix may or may not have a real square root; if it has no real negative eigenvalues. The number of square roots can vary from two to infinity. A positive definite matric has one distinguished square root, called the principal one, with the property that the eigenvalues lie in the segment \code{{z | -pi/p < arg(z) < pi/p}} (for the p-th root). The matrix square root \code{sqrtm(A)} is computed here through the Denman-Beavers iteration (see the references) with quadratic rate of convergence, a refinement of the common Newton iteration determining roots of a quadratic equation. The matrix p-th root \code{rootm(A)} is computed as a complex integral \deqn{ A^{1/p} = \frac{p \sin(\pi/p)}{\pi} A \int_0^{\infty} (x^p I + A)^{-1} dx} applying the trapezoidal rule along the unit circle. One application is the computation of the matrix logarithm as \deqn{\log A = 2^k log A^{1/2^k}} such that the argument to the logarithm is close to the identity matrix and the Pade approximation can be applied to \eqn{\log(I + X)}. The matrix sector function is defined as \code{sectm(A,m)=(A^m)^(-1/p)\%*\%A}; for \code{p=2} this is the matrix sign function. \code{S=signm(A)} is real if A is and has the following properties:\cr \code{S^2=Id; S A = A S}\cr \code{singm([0 A; B 0])=[0 C; C^-1 0]} where \code{C=A(BA)^-1} These functions arise in control theory. } \value{ \code{sqrtm(A)} returns a list with components \item{ B }{square root matrix of \code{A}.} \item{ Binv }{inverse of the square root matrix.} \item{ k }{number of iterations.} \item{ acc }{accuracy or absolute error.} \code{rootm(A)} returns a list with components \item{ B }{square root matrix of \code{A}.} \item{ k }{number of iterations.} \item{ acc }{accuracy or absolute error.} If \code{k} is negative the iteration has \emph{not} converged. \code{signm} just returns one matrix, even when there was no convergence. } \note{ The p-th root of a positive definite matrix can also be computed from its eigenvalues as \code{E <- eigen(A)}\cr \code{V <- E\$vectors; U <- solve(V)}\cr \code{D <- diag(E\$values)}\cr \code{B <- V \%*\% D^(1/p) \%*\% U} or by applying the functions \code{expm}, \code{logm} in package `expm': \code{B <- expm(1/p * logm(A))} As these approaches all calculate the principal branch, the results are identical (but will numerically slightly differ). } \references{ N. J. Higham (1997). Stable Iterations for the Matrix Square Root. Numerical Algorithms, Vol. 15, pp. 227--242. D. A. Bini, N. J. Higham, and B. Meini (2005). Algorithms for the matrix pth root. Numerical Algorithms, Vol. 39, pp. 349--378. } \seealso{ \code{\link{expm}}, \code{expm::sqrtm} } \examples{ A1 <- matrix(c(10, 7, 8, 7, 7, 5, 6, 5, 8, 6, 10, 9, 7, 5, 9, 10), nrow = 4, ncol = 4, byrow = TRUE) X <- sqrtm(A1)$B # accuracy: 2.352583e-13 X %*% X # A1 A2 <- matrix(c(90.81, 8.33, 0.68, 0.06, 0.08, 0.02, 0.01, 0.01, 0.70, 90.65, 7.79, 0.64, 0.06, 0.13, 0.02, 0.01, 0.09, 2.27, 91.05, 5.52, 0.74, 0.26, 0.01, 0.06, 0.02, 0.33, 5.95, 85.93, 5.30, 1.17, 1.12, 0.18, 0.03, 0.14, 0.67, 7.73, 80.53, 8.84, 1.00, 1.06, 0.01, 0.11, 0.24, 0.43, 6.48, 83.46, 4.07, 5.20, 0.21, 0, 0.22, 1.30, 2.38, 11.24, 64.86, 19.79, 0, 0, 0, 0, 0, 0, 0, 100 ) / 100, nrow = 8, ncol = 8, byrow = TRUE) X <- rootm(A2, 12) # k = 6, accuracy: 2.208596e-14 ## Matrix sign function signm(A1) # 4x4 identity matrix B <- rbind(cbind(zeros(4,4), A1), cbind(eye(4), zeros(4,4))) signm(B) # [0, signm(A1)$B; signm(A1)$Binv 0] } \keyword{ math } pracma/man/savgol.Rd0000644000176200001440000000266113034767277014077 0ustar liggesusers\name{savgol} \alias{savgol} \title{ Savitzky-Golay Smoothing } \description{ Polynomial filtering method of Savitzky and Golay. } \usage{ savgol(T, fl, forder = 4, dorder = 0) } \arguments{ \item{T}{Vector of signals to be filtered.} \item{fl}{Filter length (for instance fl = 51..151), has to be odd.} \item{forder}{Filter order (2 = quadratic filter, 4 = quartic).} \item{dorder}{Derivative order (0 = smoothing, 1 = first derivative, etc.).} } \details{ Savitzky-Golay smoothing performs a local polynomial regression on a series of values which are treated as being equally spaced to determine the smoothed value for each point. Methods are also provided for calculating derivatives. } \value{ Vector representing the smoothed time series. } \references{ See Numerical Recipes, 1992, Chapter 14.8, for details. } \author{ Peter Riegler implemented a Matlab version in 2001. Based on this, Hans W. Borchers published an R version in 2003. } \note{ For derivatives T2 has to be divided by the step size to the order\cr (and to be multiplied by k! --- the sign appears to be wrong). } \seealso{ \code{RTisean::sav_gol}, \code{signal::sgolayfilt}, \code{\link{whittaker}}. } \examples{ # *** Sinosoid test function *** ts <- sin(2*pi*(1:1000)/200) t1 <- ts + rnorm(1000)/10 t2 <- savgol(t1, 51) \dontrun{ plot( 1:1000, t1, col = "grey") lines(1:1000, ts, col = "blue") lines(1:1000, t2, col = "red")} } \keyword{ timeseries } pracma/man/findintervals.Rd0000644000176200001440000000150511652316301015426 0ustar liggesusers\name{findintervals} \alias{findintervals} \title{ Find Interval Indices } \description{ Find indices \code{i} in vector \code{xs} such that either \code{x=xs[i]} or such that \code{xs[i]x>xs[i+1]}. } \usage{ findintervals(x, xs) } \arguments{ \item{x}{single number.} \item{xs}{numeric vector, not necessarily sorted.} } \details{ Contrary to \code{findInterval}, the vector \code{xs} in \code{findintervals} need not be sorted. } \value{ Vector of indices in \code{1..length(xs)}. If none is found, returns \code{integer(0)}. } \note{ If \code{x} is equal to the last element in \code{xs}, the index \code{length(xs)} will also be returned. } \examples{ xs <- zapsmall(sin(seq(0, 10*pi, len=100))) findintervals(0, xs) # 1 10 20 30 40 50 60 70 80 90 100 } \keyword{ logic } pracma/man/trapz.Rd0000644000176200001440000000466712666362554013753 0ustar liggesusers\name{trapz} \alias{trapz} \alias{cumtrapz} \alias{trapzfun} \title{Trapezoidal Integration} \description{ Compute the area of a function with values \code{y} at the points \code{x}. } \usage{ trapz(x, y) cumtrapz(x, y) trapzfun(f, a, b, maxit = 25, tol = 1e-07, ...) } \arguments{ \item{x}{x-coordinates of points on the x-axis} \item{y}{y-coordinates of function values} \item{f}{function to be integrated.} \item{a, b}{lower and upper border of the integration domain.} \item{maxit}{maximum number of steps.} \item{tol}{tolerance; stops when improvements are smaller.} \item{...}{arguments passed to the function.} } \details{ The points \code{(x, 0)} and \code{(x, y)} are taken as vertices of a polygon and the area is computed using \code{polyarea}. This approach matches exactly the approximation for integrating the function using the trapezoidal rule with basepoints \code{x}. \code{cumtrapz} computes the cumulative integral of \code{y} with respect to \code{x} using trapezoidal integration. \code{x} and \code{y} must be vectors of the same length, or \code{x} must be a vector and \code{y} a matrix whose first dimension is \code{length(x)}. Inputs \code{x} and \code{y} can be complex. \code{trapzfun} realizes trapezoidal integration and stops when the differencefrom one step to the next is smaller than tolerance (or the of iterations get too big). The function will only be evaluated once on each node. } \value{ Approximated integral of the function, discretized through the points \code{x, y}, from \code{min(x)} to \code{max(x)}. Or a matrix of the same size as \code{y}. \code{trapzfun} returns a lst with components \code{value} the value of the integral, \code{iter} the number of iterations, and \code{rel.err} the relative error. } \seealso{ \code{\link{polyarea}} } \examples{ # Calculate the area under the sine curve from 0 to pi: n <- 101 x <- seq(0, pi, len = n) y <- sin(x) trapz(x, y) #=> 1.999835504 # Use a correction term at the boundary: -h^2/12*(f'(b)-f'(a)) h <- x[2] - x[1] ca <- (y[2]-y[1]) / h cb <- (y[n]-y[n-1]) / h trapz(x, y) - h^2/12 * (cb - ca) #=> 1.999999969 # Use two complex inputs z <- exp(1i*pi*(0:100)/100) ct <- cumtrapz(z, 1/z) ct[101] #=> 0+3.14107591i f <- function(x) x^(3/2) # trapzfun(f, 0, 1) #=> 0.4 with 11 iterations } \keyword{ math } pracma/man/lsqnonlin.Rd0000644000176200001440000001722612301624171014601 0ustar liggesusers\name{lsqnonlin} \alias{lsqnonlin} \alias{lsqnonneg} \alias{lsqcurvefit} \alias{lsqsep} \title{ Nonlinear Least-Squares Fitting } \description{ \code{lsqnonlin} solves nonlinear least-squares problems, including nonlinear data-fitting problems, through the Levenberg-Marquardt approach. \code{lsqnonneg} solve nonnegative least-squares constraints problem. } \usage{ lsqnonlin(fun, x0, options = list(), ...) lsqnonneg(C, d) lsqsep(flist, p0, xdata, ydata, const = TRUE) lsqcurvefit(fun, p0, xdata, ydata) } \arguments{ \item{fun}{User-defined, vector-valued function.} \item{x0}{starting point.} \item{...}{additional parameters passed to the function.} \item{options}{list of options, for details see below.} \item{C, d}{matrix and vector such that \code{C x - d} will be minimized with \code{x >= 0}.} \item{flist}{list of (nonlinear) functions, depending on one extra parameter.} \item{p0}{starting parameters.} \item{xdata, ydata}{data points to be fitted.} \item{const}{logical; shall a constant term be included.} } \details{ \code{lsqnonlin} computes the sum-of-squares of the vector-valued function \code{fun}, that is if \eqn{f(x) = (f_1(x), \ldots ,f_n(x))} then \deqn{min || f(x) ||_2^2 = min(f_1(x)^2 + \ldots + f_n(x)^2)} will be minimized. \code{x=lsqnonlin(fun,x0)} starts at point \code{x0} and finds a minimum of the sum of squares of the functions described in fun. \code{fun} shall return a vector of values and not the sum of squares of the values. (The algorithm implicitly sums and squares fun(x).) \code{options} is a list with the following components and defaults: \itemize{ \item \code{tau}: used as starting value for Marquardt parameter. \item \code{tolx}: stopping parameter for step length. \item \code{tolg}: stopping parameter for gradient. \item \code{maxeval} the maximum number of function evaluations. } Typical values for \code{tau} are from \code{1e-6...1e-3...1} with small values for good starting points and larger values for not so good or known bad starting points. \code{lsqnonneg} solves the linear least-squares problem \code{C x - d}, \code{x} nonnegative, treating it through an active-set approach.. \code{lsqsep} solves the separable least-squares fitting problem \code{y = a0 + a1*f1(b1, x) + ... + an*fn(bn, x)} where \code{fi} are nonlinear functions each depending on a single extra paramater \code{bi}, and \code{ai} are additional linear parameters that can be separated out to solve a nonlinear problem in the \code{bi} alone. \code{lsqcurvefit} is simply an application of \code{lsqnonlin} to fitting data points. \code{fun(p, x)} must be a function of two groups of variables such that \code{p} will be varied to minimize the least squares sum, see the example below. } \value{ \code{lsqnonlin} returns a list with the following elements: \itemize{ \item \code{x}: the point with least sum of squares value. \item \code{ssq}: the sum of squares. \item \code{ng}: norm of last gradient. \item \code{nh}: norm of last step used. \item \code{mu}: damping parameter of Levenberg-Marquardt. \item \code{neval}: number of function evaluations. \item \code{errno}: error number, corresponds to error message. \item \code{errmess}: error message, i.e. reason for stopping. } \code{lsqnonneg} returns a list of \code{x} the non-negative solition, and \code{resid.norm} the norm of the residual. \code{lsqsep} will return the coefficients sparately, \code{a0} for the constant term (being 0 if \code{const=FALSE}) and the vectors \code{a} and \code{b} for the linear and nonlinear terms, respectively. } \note{ The refined approach, Fletcher's version of the Levenberg-Marquardt algorithm, may be added at a later time; see the references. } \references{ Madsen, K., and H. B.Nielsen (2010). Introduction to Optimization and Data Fitting. Technical University of Denmark, Intitute of Computer Science and Mathematical Modelling. Lawson, C.L., and R.J. Hanson (1974). Solving Least-Squares Problems. Prentice-Hall, Chapter 23, p. 161. Fletcher, R., (1971). A Modified Marquardt Subroutine for Nonlinear Least Squares. Report AERE-R 6799, Harwell. } \seealso{ \code{\link{nlm}}, \code{\link{nls}} } \examples{ ## Rosenberg function as least-squares problem x0 <- c(0, 0) fun <- function(x) c(10*(x[2]-x[1]^2), 1-x[1]) lsqnonlin(fun, x0) ## Example from R-help y <- c(5.5199668, 1.5234525, 3.3557000, 6.7211704, 7.4237955, 1.9703127, 4.3939336, -1.4380091, 3.2650180, 3.5760906, 0.2947972, 1.0569417) x <- c(1, 0, 0, 4, 3, 5, 12, 10, 12, 100, 100, 100) # Define target function as difference f <- function(b) b[1] * (exp((b[2] - x)/b[3]) * (1/b[3]))/(1 + exp((b[2] - x)/b[3]))^2 - y x0 <- c(21.16322, 8.83669, 2.957765) lsqnonlin(f, x0) # ssq 50.50144 at c(36.133144, 2.572373, 1.079811) # nls() will break down # nls(Y ~ a*(exp((b-X)/c)*(1/c))/(1 + exp((b-X)/c))^2, # start=list(a=21.16322, b=8.83669, c=2.957765), algorithm = "plinear") # Error: step factor 0.000488281 reduced below 'minFactor' of 0.000976563 ## Example: Hougon function x1 <- c(470, 285, 470, 470, 470, 100, 100, 470, 100, 100, 100, 285, 285) x2 <- c(300, 80, 300, 80, 80, 190, 80, 190, 300, 300, 80, 300, 190) x3 <- c( 10, 10, 120, 120, 10, 10, 65, 65, 54, 120, 120, 10, 120) rate <- c(8.55, 3.79, 4.82, 0.02, 2.75, 14.39, 2.54, 4.35, 13.00, 8.50, 0.05, 11.32, 3.13) fun <- function(b) (b[1]*x2 - x3/b[5])/(1 + b[2]*x1 + b[3]*x2 + b[4]*x3) - rate lsqnonlin(fun, rep(1, 5)) # $x [1.25258502 0.06277577 0.04004772 0.11241472 1.19137819] # $ssq 0.298901 ## Example for lsqnonneg() C1 <- matrix( c(0.1210, 0.2319, 0.4398, 0.9342, 0.1370, 0.4508, 0.2393, 0.3400, 0.2644, 0.8188, 0.7159, 0.0498, 0.3142, 0.1603, 0.4302, 0.8928, 0.0784, 0.3651, 0.8729, 0.8903, 0.2731, 0.6408, 0.3932, 0.2379, 0.7349, 0.2548, 0.1909, 0.5915, 0.6458, 0.6873, 0.8656, 0.8439, 0.1197, 0.9669, 0.3461, 0.2324, 0.1739, 0.0381, 0.6649, 0.1660, 0.8049, 0.1708, 0.4586, 0.8704, 0.1556, 0.9084, 0.9943, 0.8699, 0.0099, 0.1911), ncol = 5, byrow = TRUE) C2 <- C1 - 0.5 d <- c(0.4225, 0.8560, 0.4902, 0.8159, 0.4608, 0.4574, 0.4507, 0.4122, 0.9016, 0.0056) ( sol <- lsqnonneg(C1, d) ) #-> resid.norm 0.3694372 ( sol <- lsqnonneg(C2, d) ) #-> $resid.norm 2.863979 ## Example for lsqcurvefit() # Lanczos1 data (artificial data) # f(x) = 0.0951*exp(-x) + 0.8607*exp(-3*x) + 1.5576*exp(-5*x) x <- linspace(0, 1.15, 24) y <- c(2.51340000, 2.04433337, 1.66840444, 1.36641802, 1.12323249, 0.92688972, 0.76793386, 0.63887755, 0.53378353, 0.44793636, 0.37758479, 0.31973932, 0.27201308, 0.23249655, 0.19965895, 0.17227041, 0.14934057, 0.13007002, 0.11381193, 0.10004156, 0.08833209, 0.07833544, 0.06976694, 0.06239313) p0 <- c(1.2, 0.3, 5.6, 5.5, 6.5, 7.6) fp <- function(p, x) p[1]*exp(-p[2]*x) + p[3]*exp(-p[4]*x) + p[5]*exp(-p[6]*x) lsqcurvefit(fp, p0, x, y) ## Example for lsqsep() f <- function(x) 0.5 + x^-0.5 + exp(-0.5*x) set.seed(8237); n <- 15 x <- sort(0.5 + 9*runif(n)) y <- f(x) #y <- f(x) + 0.01*rnorm(n) m <- 2 f1 <- function(b, x) x^b f2 <- function(b, x) exp(b*x) flist <- list(f1, f2) start <- c(-0.25, -0.75) sol <- lsqsep(flist, start, x, y, const = TRUE) a0 <- sol$a0; a <- sol$a; b <- sol$b fsol <- function(x) a0 + a[1]*f1(b[1], x) + a[2]*f2(b[2], x) \dontrun{ ezplot(f, 0.5, 9.5, col = "gray") points(x, y, col = "blue") xs <- linspace(0.5, 9.5, 51) ys <- fsol(xs) lines(xs, ys, col = "red") } } \keyword{ fitting } pracma/man/lambertW.Rd0000644000176200001440000000511014000041732014320 0ustar liggesusers\name{lambertWp} \alias{lambertWp} \alias{lambertWn} \title{ Lambert's W Function } \description{ Principal real branch of the Lambert W function. } \usage{ lambertWp(x) lambertWn(x) } \arguments{ \item{x}{Numeric vector of real numbers \code{>= -1/e}.} } \details{ The Lambert W function is the inverse of \code{x --> x e^x}, with two real branches, W0 for \code{x >= -1/e} and W-1 for \code{-1/e <= x < 0}. Here the principal branch is called \code{lambertWp}, tho other one \code{lambertWp}, computed for real \code{x}. The value is calculated using an iteration that stems from applying Halley's method. This iteration is quite fast and accurate. The functions is not really vectorized, but at least returns a vector of values when presented with a numeric vector of length \code{>= 2}. } \value{ Returns the solution \code{w} of \code{w*exp(w) = x} for real \code{x} with \code{NaN} if \code{x < 1/exp(1)} (resp. \code{x >= 0} for the second branch). } \references{ Corless, R. M., G. H.Gonnet, D. E. G Hare, D. J. Jeffrey, and D. E. Knuth (1996). On the Lambert W Function. Advances in Computational Mathematics, Vol. 5, pp. 329-359. } \note{ See the examples how values for the second branch or the complex Lambert W function could be calculated by Newton's method. } \seealso{ \code{\link{halley}} } \examples{ ## Examples lambertWp(0) #=> 0 lambertWp(1) #=> 0.5671432904097838... Omega constant lambertWp(exp(1)) #=> 1 lambertWp(-log(2)/2) #=> -log(2) # The solution of x * a^x = z is W(log(a)*z)/log(a) # x * 123^(x-1) = 3 lambertWp(3*123*log(123))/log(123) #=> 1.19183018... x <- seq(-0.35, 0.0, by=0.05) w <- lambertWn(x) w * exp(w) # max. error < 3e-16 # [1] -0.35 -0.30 -0.25 -0.20 -0.15 -0.10 -0.05 NaN \dontrun{ xs <- c(-1/exp(1), seq(-0.35, 6, by=0.05)) ys <- lambertWp(xs) plot(xs, ys, type="l", col="darkred", lwd=2, ylim=c(-2,2), main="Lambert W0 Function", xlab="", ylab="") grid() points(c(-1/exp(1), 0, 1, exp(1)), c(-1, 0, lambertWp(1), 1)) text(1.8, 0.5, "Omega constant") } ## Analytic derivative of lambertWp (similar for lambertWn) D_lambertWp <- function(x) { xw <- lambertWp(x) 1 / (1+xw) / exp(xw) } D_lambertWp(c(-1/exp(1), 0, 1, exp(1))) # [1] Inf 1.0000000 0.3618963 0.1839397 ## Second branch resp. the complex function lambertWm() F <- function(xy, z0) { z <- xy[1] + xy[2]*1i fz <- z * exp(z) - z0 return(c(Re(fz), Im(fz))) } newtonsys(F, c(-1, -1), z0 = -0.1) #=> -3.5771520639573 newtonsys(F, c(-1, -1), z0 = -pi/2) #=> -1.5707963267949i = -pi/2 * 1i } \keyword{ specfun } pracma/man/interp2.Rd0000644000176200001440000000421313024246505014143 0ustar liggesusers\name{interp2} \alias{interp2} \title{ Two-dimensional Data Interpolation } \description{ Two-dimensional data interpolation similar to a table look-up. } \usage{ interp2(x, y, Z, xp, yp, method = c("linear", "nearest", "constant")) } \arguments{ \item{x, y}{vectors with monotonically increasing elements, representing x- and y-coordinates of the data values in \code{Z}.} \item{Z}{numeric \code{length(y)}-by-\code{length(x)} matrix.} \item{xp, yp}{x-, y-coordinates of points at which interpolated values will be computed.} \item{method}{interpolation method, ``linear'' the most useful.} } \details{ Computes a vector containing elements corresponding to the elements of \code{xp} and \code{yp}, determining by interpolation within the two-dimensional function specified by vectors \code{x} and \code{y}, and matrix \code{Z}. \code{x} and \code{y} must be monotonically increasing. They specify the points at which the data \code{Z} is given. Therefore, \code{length(x) = nrow(Z)} and \code{length(y) = ncol(Z)} must be satisfied. \code{xp} and \code{yp} must be of the same length. The functions appears vectorized as \code{xp}, \code{yp} can be vectors, but internally they are treated in a \code{for} loop. } \value{ Vector the length of \code{xp} of interpolated values. For methods ``constant'' and ``nearest'' the intervals are considered closed from left and below. Out of range values are returned as NAs. } \note{ The corresponding Matlab function has also the methods ``cubic'' and ``spline''. If in need of a nonlinear interpolation, take a look at \code{barylag2d} in this package and the example therein. } \seealso{ \code{\link{interp1}}, \code{barylag2d} } \examples{ \dontrun{ x <- linspace(-1, 1, 11) y <- linspace(-1, 1, 11) mgrid <- meshgrid(x, y) Z <- mgrid$X^2 + mgrid$Y^2 xp <- yp <- linspace(-1, 1, 101) method <- "linear" zp <- interp2(x, y, Z, xp, yp, method) plot(xp, zp, type = "l", col = "blue") method = "nearest" zp <- interp2(x, y, Z, xp, yp, method) lines(xp, zp, col = "red") grid()} } \keyword{ math } pracma/man/quadgk.Rd0000644000176200001440000000235413101333231014025 0ustar liggesusers\name{quadgk} \alias{quadgk} \title{ Adaptive Gauss-Kronrod Quadrature } \description{ Adaptive Gauss-Kronrod Quadrature. } \usage{ quadgk(f, a, b, tol = .Machine$double.eps^0.5, ...) } \arguments{ \item{f}{integrand as function; needs to be vectorized, but may have singularities at the endpoints.} \item{a, b}{endpoints of the integration interval.} \item{tol}{relative tolerence.} \item{\ldots}{Additional parameters to be passed to the function f.} } \details{ Adaptive version of the (7, 15)-point Gauss-Kronrod quadrature formula, where in each recursion the error is taken as the difference between these two estimated integrals. The function \code{f} must be vectorized, though this will not be checked and may lead to strange errors. If it is not, use \code{F = Vectorize(f)}. } \value{ Value of the integration. The relative error should be of the same order of magnitude as the relative tolerance (or much smaller). } \note{ Uses the same nodes and weights as the \code{quadQK15} procedure in the QUADPACK library. } \seealso{ \code{gauss_kronrod} } \examples{ ## Dilogarithm function flog <- function(t) log(1-t)/t quadgk(flog, 1, 0, tol = 1e-12) # 1.644934066848128 - pi^2/6 < 1e-13 } \keyword{ math } pracma/man/chebApprox.Rd0000644000176200001440000000333212042212424014644 0ustar liggesusers\name{chebApprox} \alias{chebApprox} \title{Chebyshev Approximation} \description{ Function approximation through Chebyshev polynomials (of the first kind). } \usage{ chebApprox(x, fun, a, b, n) } \arguments{ \item{x}{Numeric vector of points within interval \code{[a, b]}.} \item{fun}{Function to be approximated.} \item{a, b}{Endpoints of the interval.} \item{n}{An integer \code{>= 0}.} } \details{ Return approximate y-coordinates of points at x by computing the Chebyshev approximation of degree n for \code{fun} on the interval \code{[a, b]}. } \value{ A numeric vector of the same length as \code{x}. } \references{ Press, W. H., S. A. Teukolsky, W. T. Vetterling, and B. P. Flannery (1992). Numerical Recipes in C: The Art of Scientific Computing. Second Edition, Cambridge University Press. } \note{ TODO: Evaluate the Chebyshev approximative polynomial by using the Clenshaw recurrence formula. (Not yet vectorized, that's why we still use the Horner scheme.) } \seealso{ \code{\link{polyApprox}} } \examples{ # Approximate sin(x) on [-pi, pi] with a polynomial of degree 9 ! # This polynomial has to be beaten: # P(x) = x - 1/6*x^3 + 1/120*x^5 - 1/5040*x^7 + 1/362880*x^9 # Compare these polynomials p1 <- rev(c(0, 1, 0, -1/6, 0, 1/120, 0, -1/5040, 0, 1/362880)) p2 <- chebCoeff(sin, -pi, pi, 9) # Estimate the maximal distance x <- seq(-pi, pi, length.out = 101) ys <- sin(x) yp <- polyval(p1, x) yc <- chebApprox(x, sin, -pi, pi, 9) max(abs(ys-yp)) # 0.006925271 max(abs(ys-yc)) # 1.151207e-05 \dontrun{ # Plot the corresponding curves plot(x, ys, type = "l", col = "gray", lwd = 5) lines(x, yp, col = "navy") lines(x, yc, col = "red") grid()} } \keyword{ math } pracma/man/entropy.Rd0000644000176200001440000000670712745775605014313 0ustar liggesusers\name{approx_entropy} \alias{approx_entropy} \alias{sample_entropy} \title{ Approximate and Sample Entropy } \description{ Calculates the approximate or sample entropy of a time series. } \usage{ approx_entropy(ts, edim = 2, r = 0.2*sd(ts), elag = 1) sample_entropy(ts, edim = 2, r = 0.2*sd(ts), tau = 1) } \arguments{ \item{ts}{a time series.} \item{edim}{the embedding dimension, as for chaotic time series; a preferred value is 2.} \item{r}{filter factor; work on heart rate variability has suggested setting r to be 0.2 times the standard deviation of the data.} \item{elag}{embedding lag; defaults to 1, more appropriately it should be set to the smallest lag at which the autocorrelation function of the time series is close to zero. (At the moment it cannot be changed by the user.)} \item{tau}{delay time for subsampling, similar to \code{elag}.} } \details{ Approximate entropy was introduced to quantify the the amount of regularity and the unpredictability of fluctuations in a time series. A low value of the entropy indicates that the time series is deterministic; a high value indicates randomness. Sample entropy is conceptually similar with the following differences: It does not count self-matching, and it does not depend that much on the length of the time series. } \value{ The approximate, or sample, entropy, a scalar value. } \note{ This code here derives from Matlab versions at Mathwork's File Exchange, ``Fast Approximate Entropy'' and ``Sample Entropy'' by Kijoon Lee under BSD license. } \references{ Pincus, S.M. (1991). Approximate entropy as a measure of system complexity. Proc. Natl. Acad. Sci. USA, Vol. 88, pp. 2297--2301. Kaplan, D., M. I. Furman, S. M. Pincus, S. M. Ryan, L. A. Lipsitz, and A. L. Goldberger (1991). Aging and the complexity of cardiovascular dynamics, Biophysics Journal, Vol. 59, pp. 945--949. Yentes, J.M., N. Hunt, K.K. Schmid, J.P. Kaipust, D. McGrath, N. Stergiou (2012). The Appropriate use of approximate entropy and sample entropy with short data sets. Ann. Biomed. Eng. } \seealso{ \code{RHRV::CalculateApEn} } \examples{ ts <- rep(61:65, 10) approx_entropy(ts, edim = 2) # -0.0004610253 sample_entropy(ts, edim = 2) # 0 set.seed(8237) approx_entropy(rnorm(500), edim = 2) # 1.351439 high, random approx_entropy(sin(seq(1,100,by=0.2)), edim = 2) # 0.171806 low, deterministic sample_entropy(sin(seq(1,100,by=0.2)), edim = 2) # 0.2359326 \dontrun{(Careful: This will take several minutes.) # generate simulated data N <- 1000; t <- 0.001*(1:N) sint <- sin(2*pi*10*t); sd1 <- sd(sint) # sine curve whitet <- rnorm(N); sd2 <- sd(whitet) # white noise chirpt <- sint + 0.1*whitet; sd3 <- sd(chirpt) # chirp signal # calculate approximate entropy rnum <- 30; result <- zeros(3, rnum) for (i in 1:rnum) { r <- 0.02 * i result[1, i] <- approx_entropy(sint, 2, r*sd1) result[2, i] <- approx_entropy(chirpt, 2, r*sd2) result[3, i] <- approx_entropy(whitet, 2, r*sd3) } # plot curves r <- 0.02 * (1:rnum) plot(c(0, 0.6), c(0, 2), type="n", xlab = "", ylab = "", main = "Approximate Entropy") points(r, result[1, ], col="red"); lines(r, result[1, ], col="red") points(r, result[2, ], col="green"); lines(r, result[2, ], col="green") points(r, result[3, ], col="blue"); lines(r, result[3, ], col="blue") grid()} } \keyword{ timeseries } pracma/man/simpadpt.Rd0000644000176200001440000000277012042212424014377 0ustar liggesusers\name{simpadpt} \alias{simpadpt} \title{ Adaptive Simpson Quadrature } \description{ Numerically evaluate an integral using adaptive Simpson's rule. } \usage{ simpadpt(f, a, b, tol = 1e-6, ...) } \arguments{ \item{f}{univariate function, the integrand.} \item{a, b}{lower limits of integration; must be finite.} \item{tol}{relative tolerance} \item{\ldots}{additional arguments to be passed to \code{f}.} } \details{ Approximates the integral of the function \code{f} from a to b to within an error of \code{tol} using recursive adaptive Simpson quadrature. } \value{ A numerical value or vector, the computed integral. } \note{ Based on code from the book by Quarteroni et al., with some tricks borrowed from Matlab and Octave. } \references{ Quarteroni, A., R. Sacco, and F. Saleri (2007). Numerical Mathematics. Second Edition, Springer-Verlag, Berlin Heidelberg. } \seealso{ \code{\link{quad}}, \code{\link{simpson2d}} } \examples{ myf <- function(x, n) 1/(x+n) # 0.0953101798043249 , log((n+1)/n) for n=10 simpadpt(myf, 0, 1, n = 10) # 0.095310179804535 ## Dilogarithm function flog <- function(t) log(1-t) / t # singularity at t=1, almost at t=0 dilog <- function(x) simpadpt(flog, x, 0, tol = 1e-12) dilog(1) # 1.64493406685615 # 1.64493406684823 = pi^2/6 \dontrun{ N <- 51 xs <- seq(-5, 1, length.out = N) ys <- numeric(N) for (i in 1:N) ys[i] <- dilog(xs[i]) plot(xs, ys, type = "l", col = "blue", main = "Dilogarithm function") grid()} } \keyword{ math } pracma/man/fminbnd.Rd0000644000176200001440000000402512431645662014206 0ustar liggesusers\name{fminbnd} \alias{fminbnd} \title{ Finding Function Minimum } \description{ Find minimum of single-variable function on fixed interval. } \usage{ fminbnd(f, a, b, maxiter = 1000, maximum = FALSE, tol = 1e-07, rel.tol = tol, abs.tol = 1e-15, ...) } \arguments{ \item{f}{function whose minimum or maximum is to be found.} \item{a, b}{endpoints of the interval to be searched.} \item{maxiter}{maximal number of iterations.} \item{maximum}{logical; shall maximum or minimum be found; default FALSE.} \item{tol}{relative tolerance; left over for compatibility.} \item{rel.tol, abs.tol}{relative and absolute tolerance.} \item{...}{additional variables to be passed to the function.} } \details{ fminbnd finds the minimum of a function of one variable within a fixed interval. It applies Brent's algorithm, based on golden section search and parabolic interpolation. \code{fminbnd} may only give local solutions. \code{fminbnd} never evaluates \code{f} at the endpoints. } \value{ List with \item{xmin}{location of the minimum resp. maximum.} \item{fmin}{function value at the optimum.} \item{niter}{number of iterations used.} \item{estim.prec}{estimated precision.} } \references{ R. P. Brent (1973). Algorithms for Minimization Without Derivatives. Dover Publications, reprinted 2002. } \note{ \code{fminbnd} mimics the Matlab function of the same name. } \seealso{ \code{\link{fibsearch}}, \code{\link{golden_ratio}} } \examples{ ## CHEBFUN example by Trefethen f <- function(x) exp(x)*sin(3*x)*tanh(5*cos(30*x)) fminbnd(f, -1, 1) # fourth local minimum (from left) g <- function(x) complexstep(f, x) # complex-step derivative xs <- findzeros(g, -1, 1) # local minima and maxima ys <- f(xs); n0 <- which.min(ys) # index of global minimum fminbnd(f, xs[n0-1], xs[n0+1]) # xmin:0.7036632, fmin: -1.727377 \dontrun{ ezplot(f, -1, 1, n = 1000, col = "darkblue", lwd = 2) ezplot(function(x) g(x)/150, -1, 1, n = 1000, col = "darkred", add = TRUE) grid()} } \keyword{ optimize } pracma/man/hausdorff.Rd0000644000176200001440000000213211670172133014537 0ustar liggesusers\name{hausdorff_dist} \alias{hausdorff_dist} \title{Hausdorff Distance} \description{ Hausdorff distance (aka Hausdorff dimension) } \usage{ hausdorff_dist(P, Q) } \arguments{ \item{P, Q}{numerical matrices, representing points in an m-dim. space.} } \details{ Calculates the Hausdorff Distance between two sets of points, P and Q. Sets P and Q must be matrices with the same number of columns (dimensions). The `directional' Hausdorff distance (dhd) is defined as: dhd(P,Q) = max p in P [ min q in Q [ ||p-q|| ] ] Intuitively dhd finds the point p from the set P that is farthest from any point in Q and measures the distance from p to its nearest neighbor in Q. The Hausdorff Distance is defined as max(dhd(P,Q),dhd(Q,P)). } \value{ A single scalar, the Hausdorff distance (dimension). } \references{ Barnsley, M. (1993). Fractals Everywhere. Morgan Kaufmann, San Francisco. } \seealso{ \code{\link{distmat}} } \examples{ P <- matrix(c(1,1,2,2, 5,4,5,4), 4, 2) Q <- matrix(c(4,4,5,5, 2,1,2,1), 4, 2) hausdorff_dist(P, Q) # 4.242641 = sqrt(sum((c(4,2)-c(1,5))^2)) } \keyword{ math } pracma/man/histss.Rd0000644000176200001440000000201612146466630014103 0ustar liggesusers\name{histss} \alias{histss} \title{ Histogram Bin-width Optimization } \description{ Method for selecting the bin size of time histograms. } \usage{ histss(x, n = 100, plotting = FALSE) } \arguments{ \item{x}{numeric vector or matrix.} \item{n}{maximum number of bins.} \item{plotting}{logical; shall a histogram be plotted.} } \details{ Bin sizes of histograms are optimized in a way to best displays the underlying spike rate, for example in neurophysiological studies. } \value{ Returns the same list as the \code{hist} function; the list is invisible if the histogram is plotted. } \references{ Shimazaki H. and S. Shinomoto. A method for selecting the bin size of a time histogram. Neural Computation (2007) Vol. 19(6), 1503-1527 } \seealso{ \code{\link{hist}}, \code{\link{histc}} } \examples{ x <- sin(seq(0, pi/2, length.out = 200)) H <- histss(x, n = 50, plotting = FALSE) \dontrun{ plot(H, col = "gainsboro") # Compare with hist(x), or hist(x, breaks = H$breaks) # the same } } \keyword{ timeseries } pracma/man/rosser.Rd0000644000176200001440000000067112465405723014110 0ustar liggesusers\name{rosser} \alias{rosser} \title{Rosser Matrix} \description{ Generate the Rosser matrix. } \usage{ rosser() } \details{ This is a classic symmetric eigenvalue test problem. It has a double eigenvalue, three nearly equal eigenvalues, dominant eigenvalues of opposite sign, a zero eigenvalue, and a small, nonzero eigenvalue. } \value{ matrix of size 8 x 8 } \seealso{ \code{\link{wilkinson}} } \examples{ rosser() } \keyword{ specmat } pracma/man/ezcontour.Rd0000644000176200001440000000354512764776254014642 0ustar liggesusers\name{ezcontour,ezsurf,ezmesh} \alias{ezcontour} \alias{ezsurf} \alias{ezmesh} \title{ Contour, Surface, and Mesh Plotter } \description{ Easy-to-use contour and 3-D surface resp mesh plotter. } \usage{ ezcontour(f, xlim = c(-pi,pi), ylim = c(-pi,pi), n = 60, filled = FALSE, col = NULL) ezsurf(f, xlim = c(-pi, pi), ylim = c(-pi, pi), n = 60, ...) ezmesh(f, xlim = c(-pi,pi), ylim = c(-pi,pi), n = 60, ...) } \arguments{ \item{f}{2-D function to be plotted, must accept \code{(x,y)} as a vector.} \item{xlim, ylim}{defines x- and y-ranges as intervals.} \item{n}{number of grid points in each direction.} \item{col}{colour of isolines lines, resp. the surface color.} \item{filled}{logical; shall the contour plot be } \item{...}{parameters to be passed to the \code{persp} function.} } \details{ \code{ezcontour} generates a contour plot of the function \code{f} using \code{contour} (and \code{image} if \code{filled=TRUE} is chosen). If \code{filled=TRUE} is chosen, \code{col} should be a color scheme, the default is \code{heat.colors(12)}. \code{ezsurf} resp. \code{ezmesh} generates a surface/mesh plot of the function \code{f} using \code{persp}. The function \code{f} needs not be vectorized in any form. } \value{ Plots the function graph and invisibly returns \code{NULL}. } \note{ Mimicks Matlab functions of the same names; Matlab's \code{ezcontourf} can be generated with \code{filled=TRUE}. } \seealso{ \code{\link{contour}}, \code{\link{image}}, \code{\link{persp}} } \examples{ \dontrun{ f <- function(xy) { x <- xy[1]; y <- xy[2] 3*(1-x)^2 * exp(-(x^2) - (y+1)^2) - 10*(x/5 - x^3 - y^5) * exp(-x^2 - y^2) - 1/3 * exp(-(x+1)^2 - y^2) } ezcontour(f, col = "navy") ezcontour(f, filled = TRUE) ezmesh(f) ezmesh(f, col="lightblue", theta = -15, phi = 30) } } \keyword{ graphs } pracma/man/ratinterp.Rd0000644000176200001440000000366112047703445014603 0ustar liggesusers\name{ratinterp} \alias{ratinterp} \title{ Rational Interpolation } \description{ Burlisch-Stoer rational interpolation. } \usage{ ratinterp(x, y, xs = x) } \arguments{ \item{x}{numeric vector; points on the x-axis; needs to be sorted; at least three points required.} \item{y}{numeric vector; values of the assumed underlying function; \code{x} and \code{y} must be of the same length.} \item{xs}{numeric vector; points at which to compute the interpolation; all points must lie between \code{min(x)} and \code{max(x)}.} } \details{ The Burlisch-Stoer approach to rational interpolation is a recursive procedure (similar to the Newton form of polynomial interpolation) that produces a ``diagonal'' rational function, that is the degree of the numerator is either the same or one less than the degree of the denominator. Polynomial interpolation will have difficulties if some kind of singularity exists in the neighborhood, even if the pole occurs in the complex plane. For instance, Runge's function has a pole at \eqn{z = 0.2 i}, quite close to the interval \eqn{[-1, 1]}. } \value{ Numeric vector representing values at points \code{xs}. } \note{ The algorithm does not yield a simple algebraic expression for the rational function found. } \references{ Stoer, J., and R. Bulirsch (2002). Introduction to Numerical Analysis. Third Edition, Springer-Verlag, New York. Fausett, L. V. (2008). Applied Numerical Analysis Using Matlab. Second Edition, Pearson Education. } \seealso{ \code{\link{rationalfit}}, \code{\link{pade}} } \examples{ ## Rational interpolation of Runge's function x <- c(-1, -0.5, 0, 0.5, 1.0) y <- runge(x) xs <- linspace(-1, 1) ys <- runge(xs) yy <- ratinterp(x, y, xs) # returns exactly the Runge function \dontrun{ plot(xs, ys, type="l", col="blue", lty = 2, lwd = 3) points(x, y) yy <- ratinterp(x, y, xs) lines(xs, yy, col="red") grid()} } \keyword{ fitting } pracma/man/polyint.Rd0000644000176200001440000000104311540452742014257 0ustar liggesusers\name{polyint} \alias{polyint} \title{Anti-derivative of Polynomial} \description{ Integrate polynomials. } \usage{ polyint(p, k) } \arguments{ \item{p}{polynomial \code{p} given as a vector} \item{k}{an integration constant} } \details{ Calculates the integral, i.e. the antiderivative, of a polynomial and adds a constant of integration \code{k} if given, else 0. } \value{ a vector representing a polynomial } \seealso{ \code{\link{polyval}}, \code{\link{polyder}} } \examples{ polyint(c(1, 1, 1, 1, 1), 1) } \keyword{ math } pracma/man/bisect.Rd0000644000176200001440000000445613342034603014037 0ustar liggesusers\name{bisect} \alias{bisect} \alias{secant} \alias{regulaFalsi} \title{ Rootfinding Through Bisection or Secant Rule } \description{ Finding roots of univariate functions in bounded intervals. } \usage{ bisect(fun, a, b, maxiter = 500, tol = NA, ...) secant(fun, a, b, maxiter = 500, tol = 1e-08, ...) regulaFalsi(fun, a, b, maxiter = 500, tol = 1e-08, ...) } \arguments{ \item{fun}{Function or its name as a string.} \item{a, b}{interval end points.} \item{maxiter}{maximum number of iterations; default 100.} \item{tol}{absolute tolerance; default \code{eps^(1/2)}} \item{...}{additional arguments passed to the function.} } \details{ ``Bisection'' is a well known root finding algorithms for real, univariate, continuous functions. Bisection works in any case if the function has opposite signs at the endpoints of the interval. \code{bisect} stops when floating point precision is reached, attaching a tolerance is no longer needed. This version is trimmed for exactness, not speed. Special care is taken when 0.0 is a root of the function. Argument 'tol' is deprecated and not used anymore. The ``Secant rule'' uses a succession of roots of secant lines to better approximate a root of a function. ``Regula falsi'' combines bisection and secant methods. The so-called `Illinois' improvement is used here. } \value{ Return a list with components \code{root}, \code{f.root}, the function value at the found root, \code{iter}, the number of iterations done, and \code{root}, and the estimated accuracy \code{estim.prec} } \references{ Quarteroni, A., R. Sacco, and F. Saleri (2007). Numerical Mathematics. Second Edition, Springer-Verlag, Berlin Heidelberg. } \seealso{ \code{\link{ridders}} } \examples{ bisect(sin, 3.0, 4.0) # $root $f.root $iter $estim.prec # 3.1415926536 1.2246467991e-16 52 4.4408920985e-16 bisect(sin, -1.0, 1.0) # $root $f.root $iter $estim.prec # 0 0 2 0 # Legendre polynomial of degree 5 lp5 <- c(63, 0, -70, 0, 15, 0)/8 f <- function(x) polyval(lp5, x) bisect(f, 0.6, 1) # 0.9061798453 correct to 15 decimals secant(f, 0.6, 1) # 0.5384693 different root regulaFalsi(f, 0.6, 1) # 0.9061798459 correct to 10 decimals } \keyword{ math } pracma/man/expint.Rd0000644000176200001440000000417113340253715014074 0ustar liggesusers\name{expint} \alias{expint} \alias{expint_E1} \alias{expint_Ei} \alias{li} \title{ Exponential and Logarithmic Integral } \description{ The exponential integral functions E1 and Ei and the logarithmic integral Li. The exponential integral is defined for \eqn{x > 0} as \deqn{\int_x^\infty \frac{e^{-t}}{t} dt} and by analytic continuation in the complex plane. It can also be defined as the Cauchy principal value of the integral \deqn{\int_{-\infty}^x \frac{e^t}{t} dt} This is denoted as \eqn{Ei(x)} and the relationship between \code{Ei} and \code{expint(x)} for x real, x > 0 is as follows: \deqn{Ei(x) = - E1(-x) -i \pi} The logarithmic integral \eqn{li(x)} for real \eqn{x, x > 0}, is defined as \deqn{li(x) = \int_0^x \frac{dt}{log(t)}} and the Eulerian logarithmic integral as \eqn{Li(x) = li(x) - li(2)}. The integral \eqn{Li} approximates the prime number function \eqn{\pi(n)}, i.e., the number of primes below or equal to n (see the examples). } \usage{ expint(x) expint_E1(x) expint_Ei(x) li(x) } \arguments{ \item{x}{vector of real or complex numbers.} } \details{ For \code{x} in \code{[-38, 2]} we use a series expansion, otherwise a continued fraction, see the references below, chapter 5. } \value{ Returns a vector of real or complex numbers, the vectorized exponential integral, resp. the logarithmic integral. } \note{ The logarithmic integral \code{li(10^i)-li(2)} is an approximation of the number of primes below \code{10^i}, i.e., \code{Pi(10^i)}, see ``?primes''. } \references{ Abramowitz, M., and I.A. Stegun (1965). Handbook of Mathematical Functions. Dover Publications, New York. } \seealso{ \code{gsl::expint_E1,expint_Ei}, \code{\link{primes}} } \examples{ expint_E1(1:10) # 0.2193839 0.0489005 0.0130484 0.0037794 0.0011483 # 0.0003601 0.0001155 0.0000377 0.0000124 0.0000042 expint_Ei(1:10) \dontrun{ estimPi <- function(n) round(Re(li(n) - li(2))) # estimated number of primes primesPi <- function(n) length(primes(n)) # true number of primes <= n N <- 1e6 (estimPi(N) - primesPi(N)) / estimPi(N) # deviation is 0.16 percent!} } \keyword{ specfun } pracma/man/quad2d.Rd0000644000176200001440000000356414000041732013736 0ustar liggesusers\name{quad2d} \alias{quad2d} \title{ 2-d Gaussian Quadrature } \description{ Two-dimensional Gaussian Quadrature. } \usage{ quad2d(f, xa, xb, ya, yb, n = 32, ...) } \arguments{ \item{f}{function of two variables; needs to be vectorized.} \item{xa, ya}{lower limits of integration; must be finite.} \item{xb, yb}{upper limits of integration; must be finite.} \item{n}{number of nodes used per direction.} \item{\dots}{additional arguments to be passed to \code{f}.} } \details{ Extends the Gaussian quadrature to two dimensions by computing two sets of nodes and weights (in x- and y-direction), evaluating the function on this grid and multiplying weights appropriately. The function \code{f} needs to be vectorized in both variables such that \code{f(X, Y)} returns a matrix when \code{X} an \code{Y} are matrices (of the same size). \code{quad} is not suitable for functions with singularities. } \value{ A single numerical value, the computed integral. } \references{ Quarteroni, A., R. Sacco, and F. Saleri (2007). Numerical Mathematics. Second Edition, Springer-Verlag, Berlin Heidelberg. } \note{ The extension of Gaussian quadrature to two dimensions is obvious, but see also the example `integral2d.m' at Nick Trefethens ``10 digits 1 page''. } \seealso{ \code{\link{quad}}, \code{cubature::adaptIntegrate} } \examples{ ## Example: f(x, y) = (y+1)*exp(x)*sin(16*y-4*(x+1)^2) f <- function(x, y) (y+1) * exp(x) * sin(16*y-4*(x+1)^2) # this is even faster than cubature::adaptIntegral(): quad2d(f, -1, 1, -1, 1) # 0.0179515583236958 # true value 0.01795155832370 ## Volume of the sphere: use polar coordinates f0 <- function(x, y) sqrt(1 - x^2 - y^2) # for x^2 + y^2 <= 1 fp <- function(x, y) y * f0(y*cos(x), y*sin(x)) quad2d(fp, 0, 2*pi, 0, 1, n = 101) # 2.09439597740074 2/3 * pi # 2.0943951023932 } \keyword{ math } pracma/man/quadinf.Rd0000644000176200001440000000414614000041732014202 0ustar liggesusers\name{quadinf} \alias{quadinf} \title{ Infinite Integrals } \description{ Iterative quadrature of functions over finite, semifinite, or infinite intervals. } \usage{ quadinf(f, xa, xb, tol = 1e-12, ...) } \arguments{ \item{f}{univariate function; needs not be vectorized.} \item{xa}{lower limit of integration; can be infinite} \item{xb}{upper limit of integration; can be infinite} \item{tol}{accuracy requested.} \item{\dots}{additional arguments to be passed to \code{f}.} } \details{ \code{quadinf} implements the `double exponential method' for fast numerical integration of smooth real functions on finite intervals. For infinite intervals, the tanh-sinh quadrature scheme is applied, that is the transformation \code{g(t)=tanh(pi/2*sinh(t))}. Please note that this algorithm does work very accurately for `normal' function, but should not be applied to (heavily) oscillating functions. The maximal number of iterations is 7, so if this is returned the iteration may not have converged. The integrand function needs \emph{not} be vectorized. } \value{ A list with components \code{Q} the integral value, \code{relerr} the relative error, and \code{niter} the number of iterations. } \note{ See also my remarks on R-help in September 2010 in the thread ``bivariate vector numerical integration with infinite range''. } \references{ D. H. Bayley. Tanh-Sinh High-precision Quadrature. 2006.\cr URL: https://www.davidhbailey.com//dhbpapers/dhb-tanh-sinh.pdf } \seealso{ \code{\link{integrate}}, \code{\link{quadgk}} } \examples{ ## We will look at the error function exp(-x^2) f <- function(x) exp(-x^2) # sqrt(pi)/2 theory quadinf(f, 0, Inf) # 0.8862269254527413 quadinf(f, -Inf, 0) # 0.8862269254527413 f = function(x) sqrt(x) * exp(-x) # 0.8862269254527579 exact quadinf(f, 0, Inf) # 0.8862269254527579 f = function(x) x * exp(-x^2) # 1/2 quadinf(f, 0, Inf) # 0.5 f = function(x) 1 / (1+x^2) # 3.141592653589793 = pi quadinf(f, -Inf, Inf) # 3.141592653589784 } \keyword{ math } pracma/man/ridders.Rd0000644000176200001440000000750613342034603014221 0ustar liggesusers\name{ridders} \alias{ridders} \title{ Ridders' Root Finding Method } \description{ Ridders' root finding method is a powerful variant of `regula falsi' (and `false position'). In reliability and speed, this method is competitive with Brent-Dekker and similar approaches. } \usage{ ridders(fun, a, b, maxiter = 500, tol = 1e-12, ...) } \arguments{ \item{fun}{function whose root is to be found.} \item{a, b}{left and right interval bounds.} \item{maxiter}{maximum number of iterations (function calls).} \item{tol}{tolerance, length of the last interval.} \item{...}{additional parameters passed on to the function.} } \details{ Given a bracketing interval $[x_1, x_2]$, the method first calculates the midpoint \eqn{x_3 = (x_1 + x_2)/2} and the uses an updating formula \deqn{x_4 = x_3 + (x_3 - x_1) \frac{sgn(f(x_1) - f(x_2)) f(x_3)}{\sqrt{f(x_3)^2 - f(x_1) f(x_2)}}} } \value{ Returns a list with components \item{root}{root of the function.} \item{f.root}{value of the function at the found root.} \item{niter}{number of iterations,or more specifically: number of function calls.} \item{estim.prec}{the estimated precision, coming from the last brackett.} } \note{ See function \code{f12} whose zero at \eqn{\sqrt{e}} is difficult to find exactly for all root finders. } \author{ HwB email: } \references{ Press, Teukolsky, Vetterling, and Flannery (1992). Numerical Recipes in C. Cambridge University Press. } \seealso{ \code{\link{brent}} } \examples{ ## Test functions f1 <- function(x) # [0, 1.2], 0.399 422 2917 x^2 * (x^2/3 + sqrt(2)*sin(x)) - sqrt(3)/18 f2 <- function(x) 11*x^11 - 1 # [0.4, 1.6], 0.804 133 0975 f3 <- function(x) 35*x^35 - 1 # [-0.5, 1.9], 0.903 407 6632 f4 <- function(x) # [-0.5, 0.7], 0.077 014 24135 2*(x*exp(-9) - exp(-9*x)) + 1 f5 <- function(x) x^2 - (1 - x)^9 # [-1.4, 1], 0.259 204 4937 f6 <- function(x) (x-1)*exp(-9*x) + x^9 # [-0.8, 1.6], 0.536 741 6626 f7 <- function(x) x^2 + sin(x/9) - 1/4 # [-0.5, 1.9], 0.4475417621 f8 <- function(x) 1/8 * (9 - 1/x) # [0.001, 1.201], 0.111 111 1111 f9 <- function(x) tan(x) - x - 0.0463025 # [-0.9, 1.5], 0.500 000 0340 f10 <- function(x) # [0.4, 1], 0.679 808 9215 x^2 + x*sin(sqrt(75)*x) - 0.2 f11 <- function(x) x^9 + 0.0001 # [-1.2, 0], -0.359 381 3664 f12 <- function(x) # [1, 3.4], 1.648 721 27070 log(x) + x^2/(2*exp(1)) - 2 * x/sqrt(exp(1)) + 1 r <- ridders(f1 , 0, 1.2); r$root; r$niter # 18 r <- ridders(f2 , 0.4, 1.6); r$root; r$niter # 14 r <- ridders(f3 ,-0.5, 1.9); r$root; r$niter # 20 r <- ridders(f4 ,-0.5, 0.7); r$root; r$niter # 12 r <- ridders(f5 ,-1.4, 1); r$root; r$niter # 16 r <- ridders(f6 ,-0.8, 1.6); r$root; r$niter # 20 r <- ridders(f7 ,-0.5, 1.9); r$root; r$niter # 16 r <- ridders(f8 ,0.001, 1.201); r$root; r$niter # 18 r <- ridders(f9 ,-0.9, 1.5); r$root; r$niter # 20 r <- ridders(f10,0.4, 1); r$root; r$niter # 14 r <- ridders(f11,-1.2, 0); r$root; r$niter # 12 r <- ridders(f12,1, 3.4); r$root; r$niter # 30, err = 1e-5 \dontrun{ ## Use ridders() with Rmpfr options(digits=16) library("Rmpfr") # unirootR prec <- 256 .N <- function(.) mpfr(., precBits = prec) f12 <- function(x) { e1 <- exp(.N(1)) log(x) + x^2/(2*e1) - 2*x/sqrt(e1) + 1 } sqrte <- sqrt(exp(.N(1))) # 1.648721270700128... f12(sqrte) # 0 unirootR(f12, interval=mpfr(c(1, 3.4), prec), tol=1e-20) # $root # 1 'mpfr' number of precision 200 bits # [1] 1.648721270700128... ridders(f12, .N(1), .N(3.4), maxiter=200, tol=1e-20) # $root # 1 'mpfr' number of precision 200 bits # [1] 1.648721270700128... } } \keyword{ math } pracma/man/expm.Rd0000644000176200001440000000443213575441162013543 0ustar liggesusers\name{expm} \alias{expm} \alias{logm} \title{ Matrix Exponential } \description{ Computes the exponential of a matrix. } \usage{ expm(A, np = 128) logm(A) } \arguments{ \item{A}{numeric square matrix.} \item{np}{number of points to use on the unit circle.} } \details{ For an analytic function \eqn{f} and a matrix \eqn{A} the expression \eqn{f(A)} can be computed by the Cauchy integral \deqn{f(A) = (2 \pi i)^{-1} \int_G (zI-A)^{-1} f(z) dz} where \eqn{G} is a closed contour around the eigenvalues of \eqn{A}. Here this is achieved by taking G to be a circle and approximating the integral by the trapezoid rule. \code{logm} is a fake at the moment as it computes the matrix logarithm through taking the logarithm of its eigenvalues; will be replaced by an approach using Pade interpolation. Another more accurate and more reliable approach for computing these functions can be found in the R package `expm'. } \value{ Matrix of the same size as \code{A}. } \references{ Moler, C., and Ch. Van Loan (2003). Nineteen Dubious Ways to Compute the Exponential of a Matrix, Twenty-Five Years Later. SIAM Review, Vol. 1, No. 1, pp. 1--46. N. J. Higham (2008). Matrix Functions: Theory and Computation. SIAM Society for Industrial and Applied Mathematics. } \author{ Idea and Matlab code for a cubic root by Nick Trefethen in his ``10 digits 1 page'' project. } \note{ This approach could be used for other analytic functions, but a point to consider is which branch to take (e.g., for the \code{logm} function). } \seealso{ \code{expm::expm} } \examples{ ## The Ward test cases described in the help for expm::expm agree up to ## 10 digits with the values here and with results from Matlab's expm ! A <- matrix(c(-49, -64, 24, 31), 2, 2) expm(A) # -0.7357588 0.5518191 # -1.4715176 1.1036382 A1 <- matrix(c(10, 7, 8, 7, 7, 5, 6, 5, 8, 6, 10, 9, 7, 5, 9, 10), nrow = 4, ncol = 4, byrow = TRUE) expm(logm(A1)) logm(expm(A1)) ## System of linear differential equations: y' = M y (y = c(y1, y2, y3)) M <- matrix(c(2,-1,1, 0,3,-1, 2,1,3), 3, 3, byrow=TRUE) M C1 <- 0.5; C2 <- 1.0; C3 <- 1.5 t <- 2.0; Mt <- expm(t * M) yt <- Mt %*% c(C1, C2, C3) # [y1,y2,y3](t) = [C1, C2, C3] %*% t(Mt) } \keyword{ math } pracma/man/regexp.Rd0000644000176200001440000000330611546151101014046 0ustar liggesusers\name{regexp} \alias{regexp} \alias{regexpi} \title{ Match regular expression } \description{ Returns the positions of substrings that match the regular expression. } \usage{ regexp(s, pat, ignorecase = FALSE, once = FALSE, split = FALSE) regexpi(s, pat, once = FALSE, split = FALSE) } \arguments{ \item{s}{Character string, i.e. of length 1.} \item{pat}{Matching pattern as character string.} \item{ignorecase}{Logical: whether case should be ignored; default: \code{FALSE}.} \item{once}{Logical: whether the first are all occurrences should be found; default: all.} \item{split}{Logical: should the string be splitted at the occurrences of the pattern?; default: no.} } \details{ Returns the start and end positions and the exact value of substrings that match the regular expression. If \code{split} is choosen, the splitted strings will also be returned. } \value{ A list with components \code{start} and \code{end} as numeric vectors indicating the start and end positions of the matches. \code{match} contains each exact match, and \code{split} contains the character vector of splitted strings. If no match is found all components will be \code{NULL}, except \code{split} that will contain the whole string if \code{split = TRUE}. } \note{ This is the behavior of the corresponding Matlab function, though the signature, options and return values do not match exactly. Notice the transposed parameters \code{s} and \code{pat} compared to the corresponding R function \code{regexpr}. } \seealso{ \code{\link{regexpr}} } \examples{ s <- "bat cat can car COAT court cut ct CAT-scan" pat <- 'c[aeiou]+t' regexp(s, pat) regexpi(s, pat) } \keyword{ string } pracma/man/trigApprox.Rd0000644000176200001440000000262712042212424014716 0ustar liggesusers\name{trigApprox} \alias{trigApprox} \title{ Trigonometric Approximation } \description{ Computes the trigonometric series. } \usage{ trigApprox(t, x, m) } \arguments{ \item{t}{vector of points at which to compute the values of the trigonometric approximation.} \item{x}{data from \code{t=0} to \code{t=2*(n-1)*pi/n}.} \item{m}{degree of trigonometric regression.} } \details{ Calls \code{trigPoly} to get the trigonometric coefficients and then sums the finite series. } \value{ Vector of values the same length as \code{t}. } \note{ TODO: Return an approximating function instead. } \seealso{ \code{\link{trigPoly}} } \examples{ \dontrun{ ## Example: Gauss' Pallas data (1801) asc <- seq(0, 330, by = 30) dec <- c(408, 89, -66, 10, 338, 807, 1238, 1511, 1583, 1462, 1183, 804) plot(2*pi*asc/360, dec, pch = "+", col = "red", xlim = c(0, 2*pi), ylim = c(-500, 2000), xlab = "Ascension [radians]", ylab = "Declination [minutes]", main = "Gauss' Pallas Data") grid() points(2*pi*asc/360, dec, pch = "o", col = "red") ts <- seq(0, 2*pi, len = 100) xs <- trigApprox(ts ,dec, 1) lines(ts, xs, col = "black") xs <- trigApprox(ts ,dec, 2) lines(ts, xs, col = "blue") legend(3, 0, c("Trig. Regression of degree 1", "Trig. Regression of degree 2", "Astronomical position"), col = c("black", "blue", "red"), lty = c(1,1,0), pch = c("", "", "+"))} } \keyword{ math } pracma/man/hampel.Rd0000644000176200001440000000321112042212424014013 0ustar liggesusers\name{hampel} \alias{hampel} \title{ Hampel Filter } \description{ Median absolute deviation (MAD) outlier in Time Series } \usage{ hampel(x, k, t0 = 3) } \arguments{ \item{x}{numeric vector representing a time series} \item{k}{window length \code{2*k+1} in indices} \item{t0}{threshold, default is 3 (Pearson's rule), see below.} } \details{ The `median absolute deviation' computation is done in the \code{[-k...k]} vicinity of each point at least \code{k} steps away from the end points of the interval. At the lower and upper end the time series values are preserved. A high threshold makes the filter more forgiving, a low one will declare more points to be outliers. \code{t0<-3} (the default) corresponds to Ron Pearson's 3 sigma edit rule, \code{t0<-0} to John Tukey's median filter. } \value{ Returning a list \code{L} with \code{L$y} the corrected time series and \code{L$ind} the indices of outliers in the `median absolut deviation' sense. } \note{ Don't take the expression \emph{outlier} too serious. It's just a hint to values in the time series that appear to be unusual in the vicinity of their neighbors under a normal distribution assumption. } \references{ Pearson, R. K. (1999). ``Data cleaning for dynamic modeling and control''. European Control Conference, ETH Zurich, Switzerland. } \seealso{ \code{\link{findpeaks}} } \examples{ set.seed(8421) x <- numeric(1024) z <- rnorm(1024) x[1] <- z[1] for (i in 2:1024) { x[i] <- 0.4*x[i-1] + 0.8*x[i-1]*z[i-1] + z[i] } omad <- hampel(x, k=20) \dontrun{ plot(1:1024, x, type="l") points(omad$ind, x[omad$ind], pch=21, col="darkred") grid()} } \keyword{ timeseries } pracma/man/integral.Rd0000644000176200001440000000776013101333231014364 0ustar liggesusers\name{integral} \alias{integral} \title{ Adaptive Numerical Integration } \description{ Combines several approaches to adaptive numerical integration of functions of one variable. } \usage{ integral(fun, xmin, xmax, method = c("Kronrod", "Clenshaw","Simpson"), no_intervals = 8, random = FALSE, reltol = 1e-8, abstol = 0, ...) } \arguments{ \item{fun}{integrand, univariate (vectorized) function.} \item{xmin,xmax}{endpoints of the integration interval.} \item{method}{integration procedure, see below.} \item{no_intervals}{number of subdivisions at at start.} \item{random}{logical; shall the length of subdivisions be random.} \item{reltol}{relative tolerance.} \item{abstol}{absolute tolerance; not used.} \item{...}{additional parameters to be passed to the function.} } \details{ \code{integral} combines the following methods for adaptive numerical integration (also available as separate functions): \itemize{ \item Kronrod (Gauss-Kronrod) \item Clenshaw (Clenshaw-Curtis; not yet made adaptive) \item Simpson (adaptive Simpson) } Recommended default method is Gauss-Kronrod. Also try Clenshaw-Curtis that may be faster at times. Most methods require that function \code{f} is vectorized. This will be checked and the function vectorized if necessary. By default, the integration domain is subdivided into \code{no_intervals} subdomains to avoid 0 results if the support of the integrand function is small compared to the whole domain. If \code{random} is true, nodes will be picked randomly, otherwise forming a regular division. If the interval is infinite, \code{quadinf} will be called that accepts the same methods as well. [If the function is array-valued, \code{quadv} is called that applies an adaptive Simpson procedure, other methods are ignored -- not true anymore.] } \value{ Returns the integral, no error terms given. } \references{ Davis, Ph. J., and Ph. Rabinowitz (1984). Methods of Numerical Integration. Dover Publications, New York. } \note{ \code{integral} does not provide `new' functionality, everything is already contained in the functions called here. Other interesting alternatives are Gauss-Richardson (\code{quadgr}) and Romberg (\code{romberg}) integration. } \seealso{ \code{\link{quadgk}}, \code{\link{quadgr}}, \code{quadcc}, \code{\link{simpadpt}}, \code{\link{romberg}}, \code{\link{quadv}}, \code{\link{quadinf}} } \examples{ ## Very smooth function fun <- function(x) 1/(x^4+x^2+0.9) val <- 1.582232963729353 for (m in c("Kron", "Clen", "Simp")) { Q <- integral(fun, -1, 1, reltol = 1e-12, method = m) cat(m, Q, abs(Q-val), "\n")} # Kron 1.582233 3.197442e-13 # Rich 1.582233 3.197442e-13 # use quadgr() # Clen 1.582233 3.199663e-13 # Simp 1.582233 3.241851e-13 # Romb 1.582233 2.555733e-13 # use romberg() ## Highly oscillating function fun <- function(x) sin(100*pi*x)/(pi*x) val <- 0.4989868086930458 for (m in c("Kron", "Clen", "Simp")) { Q <- integral(fun, 0, 1, reltol = 1e-12, method = m) cat(m, Q, abs(Q-val), "\n")} # Kron 0.4989868 2.775558e-16 # Rich 0.4989868 4.440892e-16 # use quadgr() # Clen 0.4989868 2.231548e-14 # Simp 0.4989868 6.328271e-15 # Romb 0.4989868 1.508793e-13 # use romberg() ## Evaluate improper integral fun <- function(x) log(x)^2 * exp(-x^2) val <- 1.9475221803007815976 Q <- integral(fun, 0, Inf, reltol = 1e-12) # For infinite domains Gauss integration is applied! cat(m, Q, abs(Q-val), "\n") # Kron 1.94752218028062 2.01587635473288e-11 ## Example with small function support fun <- function(x) if (x<=0 || x>=pi) 0 else sin(x) Fun <- Vectorize(fun) integral(fun, -100, 100, no_intervals = 1) # 0 integral(Fun, -100, 100, no_intervals = 1) # 0 integral(fun, -100, 100, random=FALSE) # 2.00000000371071 integral(fun, -100, 100, random=TRUE) # 2.00000000340142 integral(Fun, -1000, 1000, random=FALSE) # 2.00000000655435 integral(Fun, -1000, 1000, random=TRUE) # 2.00000001157690 (sometimes 0 !) } \keyword{ math } pracma/man/rectint.Rd0000644000176200001440000000176612210406370014234 0ustar liggesusers\name{rectint} \alias{rectint} \title{ Rectangle Intersection Areas } \description{ Calculates the area of intersection of rectangles, specified by position vectors \code{x} and \code{y}. } \usage{ rectint(x, y) } \arguments{ \item{x, y}{both vectors of length 4, or both matrices with 4 columns.} } \details{ Rectangles are specified as position vectors, that is \code{c(x[1],x[2])} is the lower left corner, \code{x[3]} and \code{x[4]} are width and height of the rectangle. When \code{x} and \code{y} are matrices, each row is assumed to be a position vector specifying a rectangle. } \value{ Returns a scalar if \code{x} and \code{y} are vectors. If \code{x} is a \code{n-by-4} and \code{y} a \code{m-by-4} matrix, then it returns a \code{n-by-m} matrix \code{R} with entry \code{(i,j)} being the area \code{rectint(x[i,], y[j,])}. } \seealso{ \code{\link{polyarea}} } \examples{ x <- c(0.5, 0.5, 0.25, 1.00) y <- c(0.3, 0.3, 0.35, 0.75) rectint(x, y) # [1] 0.0825 } \keyword{ math } pracma/man/ellip.Rd0000644000176200001440000000453713777657740013724 0ustar liggesusers\name{ellipke,ellipj} \alias{ellipke} \alias{ellipj} \title{ Elliptic and Jacobi Elliptic Integrals } \description{ Complete elliptic integrals of the first and second kind, and Jacobi elliptic integrals. } \usage{ ellipke(m, tol = .Machine$double.eps) ellipj(u, m, tol = .Machine$double.eps) } \arguments{ \item{u}{numeric vector.} \item{m}{input vector, all input elements must satisfy \code{0 <= x <= 1}.} \item{tol}{tolerance; default is machine precision.} } \details{ \code{ellipke} computes the complete elliptic integrals to accuracy \code{tol}, based on the algebraic-geometric mean. \code{ellipj} computes the Jacobi elliptic integrals \code{sn}, \code{cn}, and \code{dn}. For instance, \eqn{sn} is the inverse function for \deqn{u = \int_0^\phi dt / \sqrt{1 - m \sin^2 t}} with \eqn{sn(u) = \sin(\phi)}. Some definitions of the elliptic functions use the modules \code{k} instead of the parameter \code{m}. They are related by \code{k^2=m=sin(a)^2} where \code{a} is the `modular angle'. } \value{ \code{ellipke} returns list with two components, \code{k} the values for the first kind, \code{e} the values for the second kind. \code{ellipj} returns a list with components the three Jacobi elliptic integrals \code{sn}, \code{cn}, and \code{dn}. } \references{ Abramowitz, M., and I. A. Stegun (1965). Handbook of Mathematical Functions. Dover Publications, New York. } \seealso{ \code{elliptic::sn,cn,dn} } \examples{ x <- linspace(0, 1, 20) ke <- ellipke(x) \dontrun{ plot(x, ke$k, type = "l", col ="darkblue", ylim = c(0, 5), main = "Elliptic Integrals") lines(x, ke$e, col = "darkgreen") legend( 0.01, 4.5, legend = c("Elliptic integral of first kind", "Elliptic integral of second kind"), col = c("darkblue", "darkgreen"), lty = 1) grid()} ## ellipse circumference with axes a, b ellipse_cf <- function(a, b) { return(4*a*ellipke(1 - (b^2/a^2))$e) } print(ellipse_cf(1.0, 0.8), digits = 10) # [1] 5.672333578 ## Jacobi elliptic integrals u <- c(0, 1, 2, 3, 4, 5) m <- seq(0.0, 1.0, by = 0.2) je <- ellipj(u, m) # $sn 0.0000 0.8265 0.9851 0.7433 0.4771 0.9999 # $cn 1.0000 0.5630 -0.1720 -0.6690 -0.8789 0.0135 # $dn 1.0000 0.9292 0.7822 0.8176 0.9044 0.0135 je$sn^2 + je$cn^2 # 1 1 1 1 1 1 je$dn^2 + m * je$sn^2 # 1 1 1 1 1 1 } \keyword{ specfun } pracma/man/chebPoly.Rd0000644000176200001440000000312714000041732014316 0ustar liggesusers\name{chebPoly} \alias{chebPoly} \title{Chebyshev Polynomials} \description{ Chebyshev polynomials and their values. } \usage{ chebPoly(n, x = NULL) } \arguments{ \item{n}{an integer \code{>= 0}.} \item{x}{a numeric vector, possibly empty; default \code{NULL}.} } \details{ Determines an (n+1)-ny-(n+1)-Matrix of Chebyshev polynomials up to degree n. The coefficients of the first \code{n} Chebyshev polynomials are computed using the recursion formula. For computing any values at points the well known Horner schema is applied. } \value{ If \code{x} is \code{NULL}, returns an \code{(n+1)}-by-\code{(n+1)} matrix with the coefficients of the first Chebyshev polynomials from \code{0} to \code{n}, one polynomial per row with coefficients from highest to lowest order. If \code{x} is a numeric vector, returns the values of the \code{n}-th Chebyshev polynomial at the points of \code{x}. } \references{ Carothers, N. L. (1998). A Short Course on Approximation Theory. Bowling Green State University. } \note{ See the ``Chebfun Project'' by Nick Trefethen. } \seealso{ \code{\link{chebCoeff}}, \code{\link{chebApprox}} } \examples{ chebPoly(6) \dontrun{ ## Plot 6 Chebyshev Polynomials plot(0, 0, type="n", xlim=c(-1, 1), ylim=c(-1.2, 1.2), main="Chebyshev Polynomials for n=1..6", xlab="x", ylab="y") grid() x <- seq(-1, 1, length.out = 101) for (i in 1:6) { y <- chebPoly(i, x) lines(x, y, col=i) } legend(x = 0.55, y = 1.2, c("n=1", "n=2", "n=3", "n=4", "n=5", "n=6"), col = 1:6, lty = 1, bg="whitesmoke", cex = 0.75) } } \keyword{ math } pracma/man/euler_heun.Rd0000644000176200001440000000234512035364324014720 0ustar liggesusers\name{euler_heun} \alias{euler_heun} \title{ Euler-Heun ODE Solver } \description{ Euler and Euler-Heun ODE solver. } \usage{ euler_heun(f, a, b, y0, n = 100, improved = TRUE, ...) } \arguments{ \item{f}{function in the differential equation \eqn{y' = f(x, y)}.} \item{a, b}{start and end points of the interval.} \item{y0}{starting value at a.} \item{n}{number of grid points.} \item{improved}{logical; shall the Heun method be used; default TRUE.} \item{...}{additional parameters to be passed to the function.} } \details{ \code{euler_heun} is an integration method for ordinary differential equations using the simple Euler resp. the improved Euler-Heun Method. } \value{ List with components \code{t} for grid (or `time') points, and \code{y} the vector of predicted values at those grid points. } \references{ Quarteroni, A., and F. Saleri (). Scientific Computing with MATLAB and Octave. Second Edition, Springer-Verlag, Berlin Heidelberg, 2006. } \seealso{ \code{\link{cranknic}} } \examples{ ## Flame-up process f <- function(x, y) y^2 - y^3 s1 <- cranknic(f, 0, 200, 0.01) s2 <- euler_heun(f, 0, 200, 0.01) \dontrun{ plot(s1$t, s1$y, type="l", col="blue") lines(s2$t, s2$y, col="red") grid()} } \keyword{ ode } pracma/man/magic.Rd0000644000176200001440000000155711547665714013667 0ustar liggesusers\name{magic} \alias{magic} \title{Magic Square} \description{ Create a magic square. } \usage{ magic(n) } \arguments{ \item{n}{numeric scalar specifying dimensions for the result; \code{n} must be a scalar greater than or equal to 3.} } \details{ A magic square is a square matrix where all row and column sums and also the diagonal sums all have the same value. This value or the characteristic sum for a magic square of order \eqn{n} is \eqn{sum(1:n^2)/n}. } \value{ Returns an \code{n}-by-\code{n} matrix constructed from the integers \code{1} through \code{N^2} with equal row and column sums. } \note{ A magic square, scaled by its magic sum, is doubly stochastic. } \examples{ magic(3) } \author{ P. Roebuck \email{roebuck@mdanderson.org} for the first R version in the package `matlab'. The version here is more R-like. } \keyword{array} pracma/man/hypot.Rd0000644000176200001440000000135613574516673013750 0ustar liggesusers\name{hypot} \alias{hypot} \title{Hypotenuse Function} \description{ Square root of sum of squares } \usage{ hypot(x, y) } \arguments{ \item{x, y}{Vectors of real or complex numbers of the same size} } \details{ Element-by-element computation of the square root of the sum of squares of vectors resp. matrices \code{x} and \code{y}. } \value{ Returns a vector or matrix of the same size. } \note{ Returns \code{c()} if \code{x} or \code{y} is empty and the other one has length 1. If one input is scalar, the other a vector, the scalar will be extended to a vector of appropriate length. In all other cases, \code{x} and \code{y} have to be of the same size. } \examples{ hypot(3,4) hypot(1, c(3, 4, 5)) hypot(c(0, 0), c(3, 4)) } \keyword{ array } pracma/man/halley.Rd0000644000176200001440000000251514000041732014027 0ustar liggesusers\name{halley} \alias{halley} \title{ Halley's Root Finding Mathod } \description{ Finding roots of univariate functions using the Halley method. } \usage{ halley(fun, x0, maxiter = 500, tol = 1e-08, ...) } \arguments{ \item{fun}{function whose root is to be found.} \item{x0}{starting value for the iteration.} \item{maxiter}{maximum number of iterations.} \item{tol}{absolute tolerance; default \code{eps^(1/2)}} \item{...}{additional arguments to be passed to the function.} } \details{ Well known root finding algorithms for real, univariate, continuous functions; the second derivative must be smooth, i.e. continuous. The first and second derivative are computed numerically. } \value{ Return a list with components \code{root}, \code{f.root}, the function value at the found root, \code{iter}, the number of iterations done, and the estimated precision \code{estim.prec} } \references{ \url{https://mathworld.wolfram.com/HalleysMethod.html} } \seealso{ \code{\link{newtonRaphson}} } \examples{ halley(sin, 3.0) # 3.14159265358979 in 3 iterations halley(function(x) x*exp(x) - 1, 1.0) # 0.567143290409784 Gauss' omega constant # Legendre polynomial of degree 5 lp5 <- c(63, 0, -70, 0, 15, 0)/8 f <- function(x) polyval(lp5, x) halley(f, 1.0) # 0.906179845938664 } \keyword{ math } pracma/man/taylor.Rd0000644000176200001440000000236013340252156014073 0ustar liggesusers\name{taylor} \alias{taylor} \title{ Taylor Series Approximation } \description{ Local polynomial approximation through Taylor series. } \usage{ taylor(f, x0, n = 4, ...) } \arguments{ \item{f}{differentiable function.} \item{x0}{point where the series expansion will take place.} \item{n}{Taylor series order to be used; should be \code{n <= 8}.} \item{...}{more variables to be passed to function \code{f}.} } \details{ Calculates the first four coefficients of the Taylor series through numerical differentiation and uses some polynomial `yoga'. } \value{ Vector of length \code{n+1} representing a polynomial of degree \code{n}. } \note{ TODO: Pade approximation. } \seealso{ \code{\link{fderiv}} } \examples{ taylor(sin, 0, 4) #=> -0.1666666 0.0000000 1.0000000 0.0000000 taylor(exp, 1, 4) #=> 0.04166657 0.16666673 0.50000000 1.00000000 1.00000000 f <- function(x) log(1+x) p <- taylor(f, 0, 4) p # log(1+x) = 0 + x - 1/2 x^2 + 1/3 x^3 - 1/4 x^4 +- ... # [1] -0.250004 0.333334 -0.500000 1.000000 0.000000 \dontrun{ x <- seq(-1.0, 1.0, length.out=100) yf <- f(x) yp <- polyval(p, x) plot(x, yf, type = "l", col = "gray", lwd = 3) lines(x, yp, col = "red") grid()} } \keyword{ math } pracma/man/poisson2disk.Rd0000644000176200001440000000311513231236405015205 0ustar liggesusers \name{poisson2disk} \alias{poisson2disk} \title{ Poisson Disk Sampling } \description{ Approximate Poisson disk distribution of points in a rectangle. } \usage{ poisson2disk(n, a = 1, b = 1, m = 10, info = TRUE) } \arguments{ \item{n}{number of points to generate in a rectangle.} \item{a, b}{width and height of the rectangle} \item{m}{number of points to try in each step.} \item{info}{shall additional info be printed.} } \details{ Realizes Mitchell's best-candidate algorithm for creating a Poisson disk distribution on a rectangle. Can be used for sampling, and will be more appropriate in some sampling applications than uniform sampling or grid-like sampling. With m = 1 uniform sampling will be generated. } \value{ Returns the points as a matrix with two columns for x- and y-coordinates. Prints the minimal distance between points generated. } \references{ A. Lagae and Ph. Dutre. A Comparison of Methods for Generating Poisson Disk Distributions. Computer Graphics Forum, Vol. 27(1), pp. 114-129, 2008. URL: citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.192.5862 } \note{ Bridson's algorithm for Poisson disk sampling may be added later as an alternative. Also a variant that generates points in a circle. } \examples{ set.seed(1111) P <- poisson2disk(n = 20, m = 10) head(P) ## [,1] [,2] ## [1,] 0.46550264 0.41292487 ## [2,] 0.13710541 0.98737065 ## [3,] 0.96028255 0.83222920 ## [4,] 0.06044078 0.09325431 ## [5,] 0.78579426 0.09267546 ## [6,] 0.49670274 0.99852771 # Plotting points # plot(P, pch = 'x', col = "blue") } \keyword{ stat } pracma/man/perms.Rd0000644000176200001440000000122711540452742013713 0ustar liggesusers\name{perms} \alias{perms} \title{ Generate Permutations } \description{ Generates all permutations of a vector \code{a}. } \usage{ perms(a) } \arguments{ \item{a}{numeric vector of some length \code{n}} } \details{ If \code{a} is a vector of length \code{n}, generate all permutations of the elements in \code{a} as a matrix of size \code{n! x n} where each row represents one permutation. A matrix will be expanded as vector. } \value{ matrix of permutations of the elements of \code{a} } \note{ Not feasible for \code{length(a) > 10}. } \seealso{ \code{\link{randperm}} } \examples{ perms(6) perms(1:6) perms(c(1, exp(1), pi)) } \keyword{ arith } pracma/man/trace.Rd0000644000176200001440000000076312001517521013655 0ustar liggesusers\name{Trace} \alias{Trace} \title{Matrix trace} \description{ Sum of the main diagonal elements. } \usage{ Trace(a) } \arguments{ \item{a}{a square matrix} } \details{ Sums the elements of the main diagonal of areal or complrx square matrix. } \value{ scalar value } \note{ The corresponding function in Matlab/Octave is called trace(), but this in \R has a different meaning. } \seealso{ \code{\link{Diag}}, \code{\link{diag}} } \examples{ Trace(matrix(1:16, nrow=4, ncol=4)) } \keyword{ array } pracma/man/fnorm.Rd0000644000176200001440000000335112030661377013707 0ustar liggesusers\name{fnorm} \alias{fnorm} \title{ Function Norm } \description{ The \code{fnorm} function calculates several different types of function norms for depending on the argument \code{p}. } \usage{ fnorm(f, g, x1, x2, p = 2, npoints = 100) } \arguments{ \item{f, g}{functions given by name or string.} \item{x1, x2}{endpoints of the interval.} \item{p}{Numeric scalar or Inf, -Inf; default is 2.} \item{npoints}{number of points to be considered in the interval.} } \details{ \code{fnorm} returns a scalar that gives some measure of the distance of two functions \code{f} and \code{g} on the interval \code{[x1, x2]}. It takes \code{npoints} equidistant points in the interval, computes the function values for \code{f} and \code{g} and applies \code{Norm} to their difference. Especially \code{p=Inf} returns the maximum norm, while \code{fnorm(f, g, x1, x2, p = 1, npoints) / npoints} would return some estimate of the mean distance. } \value{ Numeric scalar (or \code{Inf}), or \code{NA} if one of these functions returns \code{NA}. } \note{ Another kind of `mean' distance could be calculated by integrating the difference \code{f-g} and dividing through the length of the interval. } \seealso{ \code{\link{Norm}} } \examples{ xp <- seq(-1, 1, length.out = 6) yp <- runge(xp) p5 <- polyfit(xp, yp, 5) f5 <- function(x) polyval(p5, x) fnorm(runge, f5, -1, 1, p = Inf) #=> 0.4303246 fnorm(runge, f5, -1, 1, p = Inf, npoints = 1000) #=> 0.4326690 # Compute mean distance using fnorm: fnorm(runge, f5, -1, 1, p = 1, 1000) / 1000 #=> 0.1094193 # Compute mean distance by integration: fn <- function(x) abs(runge(x) - f5(x)) integrate(fn, -1, 1)$value / 2 #=> 0.1095285 } \keyword{ math } pracma/man/hookejeeves.Rd0000644000176200001440000000442313377264142015102 0ustar liggesusers\name{hooke_jeeves} \alias{hooke_jeeves} \title{ Hooke-Jeeves Function Minimization Method } \description{ An implementation of the Hooke-Jeeves algorithm for derivative-free optimization. } \usage{ hooke_jeeves(x0, fn, ..., lb = NULL, ub = NULL, tol = 1e-08, maxfeval = 10000, target = Inf, info = FALSE) } \arguments{ \item{x0}{starting vector.} \item{fn}{nonlinear function to be minimized.} \item{...}{additional arguments to be passed to the function.} \item{lb, ub}{lower and upper bounds.} \item{tol}{relative tolerance, to be used as stopping rule.} \item{maxfeval}{maximum number of allowed function evaluations.} \item{target}{iteration stops when this value is reached.} \item{info}{logical, whether to print information during the main loop.} } \details{ This method computes a new point using the values of \code{f} at suitable points along the orthogonal coordinate directions around the last point. } \value{ List with following components: \item{xmin}{minimum solution found so far.} \item{fmin}{value of \code{f} at minimum.} \item{count}{number of function evaluations.} \item{convergence}{NOT USED at the moment.} \item{info}{special info from the solver.} } \references{ C.T. Kelley (1999), Iterative Methods for Optimization, SIAM. Quarteroni, Sacco, and Saleri (2007), Numerical Mathematics, Springer-Verlag. } \note{ Hooke-Jeeves is notorious for its number of function calls. Memoization is often suggested as a remedy. For a similar implementation of Hooke-Jeeves see the `dfoptim' package. } \seealso{ \code{\link{nelder_mead}} } \examples{ ## Rosenbrock function rosenbrock <- function(x) { n <- length(x) x1 <- x[2:n] x2 <- x[1:(n-1)] sum(100*(x1-x2^2)^2 + (1-x2)^2) } hooke_jeeves(c(0,0,0,0), rosenbrock) ## $xmin ## [1] 1.000002 1.000003 1.000007 1.000013 ## $fmin ## [1] 5.849188e-11 ## $count ## [1] 1691 ## $convergence ## [1] 0 ## $info ## $info$solver ## [1] "Hooke-Jeeves" ## $info$iterations ## [1] 26 hooke_jeeves(rep(0,4), lb=rep(-1,4), ub=0.5, rosenbrock) ## $xmin ## [1] 0.50000000 0.26221320 0.07797602 0.00608027 ## $fmin ## [1] 1.667875 ## $count ## [1] 536 ## $convergence ## [1] 0 ## $info ## $info$solver ## [1] "Hooke-Jeeves" ## $info$iterations ## [1] 26 } \keyword{ optimize } pracma/man/fzsolve.Rd0000644000176200001440000000132511617020015014241 0ustar liggesusers\name{fzsolve} \alias{fzsolve} \title{ Complex Root Finding } \description{ Find the root of a complex function } \usage{ fzsolve(fz, z0) } \arguments{ \item{fz}{complex(-analytic) function.} \item{z0}{complex point near the assumed root.} } \details{ \code{fzsolve} tries to find the root of the complex and relatively smooth (i.e., analytic) function near a starting point. The function is considered as real function \code{R^2 --> R^2} and the \code{newtonsys} function is applied. } \value{ Complex point with sufficiently small function value. } \seealso{ \code{\link{newtonsys}} } \examples{ fz <- function(z) sin(z)^2 + sqrt(z) - log(z) fzsolve(fz, 1+1i) # 0.2555197+0.8948303i } \keyword{ math } pracma/man/rot90.Rd0000644000176200001440000000111511652316301013530 0ustar liggesusers\name{rot90} \alias{rot90} \title{Matrix Rotation} \description{ Rotate matrices for 90, 180, or 270 degrees.. } \usage{ rot90(a, k = 1) } \arguments{ \item{a}{numeric or complex matrix} \item{k}{scalar integer number of times the matrix will be rotated for 90 degrees; may be negative.} } \details{ Rotates a numeric or complex matrix for 90 (k = 1), 180 (k = 2) or 270 (k = 3 or k = -1) degrees. Value of k is taken mod 4. } \value{ the original matrix rotated } \examples{ a <- matrix(1:12, nrow=3, ncol=4, byrow=TRUE) rot90(a) rot90(a, 2) rot90(a, -1) } \keyword{ manip } pracma/man/midpoint.Rd0000644000176200001440000000550012431645662014413 0ustar liggesusers\name{bulirsch-stoer} \alias{bulirsch_stoer} \alias{midpoint} \title{ Bulirsch-Stoer Algorithm } \description{ Bulirsch-Stoer algorithm for solving Ordinary Differential Equations (ODEs) very accurately. } \usage{ bulirsch_stoer(f, t, y0, ..., tol = 1e-07) midpoint(f, t0, tfinal, y0, tol = 1e-07, kmax = 25) } \arguments{ \item{f}{function describing the differential equation \eqn{y' = f(t, y)}.} \item{t}{vector of \code{x}-values where the values of the ODE function will be computed; needs to be increasingly sorted.} \item{y0}{starting values as column vector.} \item{...}{additional parameters to be passed to the function.} \item{tol}{relative tolerance in the Ricardson extrapolation.} \item{t0, tfinal}{start and end point of the interval.} \item{kmax}{maximal number of steps in the Richardson extrapolation.} } \details{ The Bulirsch-Stoer algorithm is a well-known method to obtain high-accuracy solutions to ordinary differential equations with reasonable computational efforts. It exploits the midpoint method to get good accuracy in each step. The (modified) midpoint method computes the values of the dependent variable \code{y(t)} from \code{t0} to \code{tfinal} by a sequence of substeps, applying Richardson extrapolation in each step. Bulirsch-Stoer and midpoint shall not be used with non-smooth functions or singularities inside the interval. The best way to get intermediate points \code{t = (t[1], ..., t[n])} may be to call \code{ode23} or \code{ode23s} first and use the \code{x}-values returned to start \code{bulirsch_stoer} on. } \value{ bulirsch_stoer returns a list with \code{x} the grid points input, and \code{y} a vector of function values at the se points. } \references{ J. Stoer and R. Bulirsch (2002). Introduction to Numerical Analysis. Third Edition, Texts in Applied Mathematics 12, Springer Science + Business, LCC, New York. } \author{ Copyright (c) 2014 Hans W Borchers } \note{ Will be extended to become a full-blown Bulirsch-Stoer implementation. } \seealso{ \code{\link{ode23}}, \code{\link{ode23s}} } \examples{ ## Example: y'' = -y f1 <- function(t, y) as.matrix(c(y[2], -y[1])) y0 <- as.matrix(c(0.0, 1.0)) tt <- linspace(0, pi, 13) yy <- bulirsch_stoer(f1, tt, c(0.0, 1.0)) # 13 equally-spaced grid points yy[nrow(yy), 1] # 1.1e-11 \dontrun{ S <- ode23(f1, 0, pi, c(0.0, 1.0)) yy <- bulirsch_stoer(f1, S$t, c(0.0, 1.0)) # S$x 13 irregular grid points yy[nrow(yy), 1] # 2.5e-11 S$y[nrow(S$y), 1] # -7.1e-04 ## Example: y' = -200 x y^2 # y(x) = 1 / (1 + 100 x^2) f2 <- function(t, y) -200 * t * y^2 y0 < 1 tic(); S <- ode23(f2, 0, 1, y0); toc() # 0.002 sec tic(); yy <- bulirsch_stoer(f2, S$t, y0); toc() # 0.013 sec} } \keyword{ ode } pracma/man/pchip.Rd0000644000176200001440000000333312376600234013667 0ustar liggesusers\name{pchip} \alias{pchip} \alias{pchipfun} \title{Hermitean Interpolation Polynomials} \description{ Piecewise Cubic Hermitean Interpolation Polynomials. } \usage{ pchip(xi, yi, x) pchipfun(xi, yi) } \arguments{ \item{xi, yi}{x- and y-coordinates of supporting nodes.} \item{x}{x-coordinates of interpolation points.} } \details{ \code{pchip} is a `shape-preserving' piecewise cubic Hermite polynomial approach that apptempts to determine slopes such that function values do not overshoot data values. \code{pchipfun} is a wrapper around \code{pchip} and returns a function. Both \code{pchip} and the function returned by \code{pchipfun} are vectorized. \code{xi} and \code{yi} must be vectors of the same length greater or equal 3 (for cubic interpolation to be possible), and \code{xi} must be sorted. \code{pchip} can be applied to points outside \code{[min(xi), max(xi)]}, but the result does not make much sense outside this interval. } \value{ Values of interpolated data at points \code{x}. } \references{ Moler, C. (2004). Numerical Computing with Matlab. Revised Reprint, SIAM. } \author{ Copyright of the Matlab version from Cleve Moler in his book ``Numerical Computing with Matlab'', Chapter 3 on Interpolation. R Version by Hans W. Borchers, 2011. } \seealso{ \code{\link{interp1}} } \examples{ x <- c(1, 2, 3, 4, 5, 6) y <- c(16, 18, 21, 17, 15, 12) pchip(x, y, seq(1, 6, by = 0.5)) fp <- pchipfun(x, y) fp(seq(1, 6, by = 0.5)) \dontrun{ plot(x, y, col="red", xlim=c(0,7), ylim=c(10,22), main = "Spline and 'pchip' Interpolation") grid() xs <- seq(1, 6, len=51) ys <- interp1(x, y, xs, "spline") lines(xs, ys, col="cyan") yp <- pchip(x, y, xs) lines(xs, yp, col = "magenta")} } \keyword{ math } pracma/man/nextpow2.Rd0000644000176200001440000000133312042212424014336 0ustar liggesusers\name{nextpow2} \alias{nextpow2} \title{Next Power of 2} \description{ Smallest power of 2 greater than the argument. } \usage{ nextpow2(x) } \arguments{ \item{x}{numeric scalar, vector, or matrix} } \details{ Computes the smalest integer \code{n} such that \eqn{abs(x) \le 2^n}. IF \code{x} is a vector or matrix, returns the result component-wise. For negative or complex values, the absolute value will be taken. } \value{ an integer \code{n} such that \eqn{x \le 2^n}. } \seealso{ \code{\link{pow2}} } \examples{ nextpow2(10) #=> 4 nextpow2(1:10) #=> 0 1 2 2 3 3 3 3 4 4 nextpow2(-2^10) #=> 10 nextpow2(.Machine$double.eps) #=> -52 } \keyword{ arith } pracma/man/regexprep.Rd0000644000176200001440000000216711546151101014561 0ustar liggesusers\name{regexprep} \alias{regexprep} \title{ Replace string using regular expression } \description{ Replace string using regular expression. } \usage{ regexprep(s, expr, repstr, ignorecase = FALSE, once = FALSE) } \arguments{ \item{s}{Single character string.} \item{expr}{Regular expression to be matched.} \item{repstr}{String that replaces the matched substring(s).} \item{ignorecase}{logical, whether to ignore case.} \item{once}{logical, shall only the first or all occurences be replaced.} } \details{ Matches the regular expression against the string and replaces the first or all non-overlapping occurrences with the replacement string. The syntax for regular expression has to be PERL-like. } \value{ String with substrings replaced. } \note{ The Matlab/Octave variant allows a character vector. This is not possible here as it would make the return value quite complicated. } \seealso{ \code{\link{gsub}} } \examples{ s <- "bat cat can car COAT court cut ct CAT-scan" pat <- 'c[aeiou]+t' regexprep(s, pat, '---') regexprep(s, pat, '---', once = TRUE) regexprep(s, pat, '---', ignorecase = TRUE) } \keyword{ string } pracma/man/givens.Rd0000644000176200001440000000161612042212424014047 0ustar liggesusers\name{givens} \alias{givens} \title{Givens Rotation} \description{ Givens Rotations and QR decomposition } \usage{ givens(A) } \arguments{ \item{A}{numeric square matrix.} } \details{ \code{givens(A)} returns a QR decomposition (or factorization) of the square matrix \code{A} by applying unitary 2-by-2 matrices \code{U} such that \code{U * [xk;xl] = [x,0]} where \code{x=sqrt(xk^2+xl^2)} } \value{ List with two matrices \code{Q} and \code{R}, \code{Q} orthonormal and \code{R} upper triangular, such that \code{A=Q\%*\%R}. } \references{ Golub, G. H., and Ch. F. van Loan (1996). Matrix Computations. Third edition, John Hopkins University Press, Baltimore. } \seealso{ \code{\link{householder}} } \examples{ ## QR decomposition A <- matrix(c(0,-4,2, 6,-3,-2, 8,1,-1), 3, 3, byrow=TRUE) gv <- givens(A) (Q <- gv$Q); (R <- gv$R) zapsmall(Q \%*\% R) givens(magic(5)) } \keyword{ array } pracma/man/charpoly.Rd0000644000176200001440000000213711603653545014413 0ustar liggesusers\name{charpoly} \alias{charpoly} \title{ Characteristic Polynomial } \description{ Computes the characteristic polynomial (and the inverse of the matrix, if requested) using the Faddeew-Leverrier method. } \usage{ charpoly(a, info = FALSE) } \arguments{ \item{a}{quadratic matrix; size should not be much larger than 100.} \item{info}{logical; if true, the inverse matrix will also be reported.} } \details{ Computes the characteristic polynomial recursively. In the last step the determinant and the inverse matrix can be determined without any extra cost (if the matrix is not singular). } \value{ Either the characteristic polynomial as numeric vector, or a list with components \code{cp}, the characteristic polynomial, \code{det}, the determinant, and \code{inv}, the inverse matrix, will be returned. } \references{ Hou, S.-H. (1998). Classroom Note: A Simple Proof of the Leverrier--Faddeev Characteristic Polynomial Algorithm, SIAM Review, 40(3), pp. 706--709. } \examples{ a <- magic(5) A <- charpoly(a, info = TRUE) A$cp roots(A$cp) A$det zapsmall(A$inv \%*\% a) } \keyword{ array } pracma/man/shubert.Rd0000755000176200001440000000277213233712754014255 0ustar liggesusers\name{shubert} \alias{shubert} \title{ Shubert-Piyavskii Method } \description{ Shubert-Piyavskii Univariate Function Maximization } \usage{ shubert(f, a, b, L, crit = 1e-04, nmax = 1000) } \arguments{ \item{f}{function to be optimized.} \item{a, b}{search between a and b for a maximum.} \item{L}{a Lipschitz constant for the function.} \item{crit}{critical value} \item{nmax}{maximum number of steps.} } \details{ The Shubert-Piyavskii method, often called the Sawtooth Method, finds the global maximum of a univariate function on a known interval. It is guaranteed to find the global maximum on the interval under certain conditions: The function f is Lipschitz-continuous, that is there is a constant L such that \deqn{|f(x) - f(y)| \le L |x - y|} for all \eqn{x, y} in \eqn{[a, b]}. The process is stopped when the improvement in the last step is smaller than the input argument \code{crit}. } \value{ Returns a list with the following components: \item{xopt}{the x-coordinate of the minimum found.} \item{fopt}{the function value at the minimum.} \item{nopt}{number of steps.} } \references{ Y. K. Yeo. Chemical Engineering Computation with MATLAB. CRC Press, 2017. } \seealso{ \code{\link{findmins}} } \examples{ # Determine the global minimum of sin(1.2*x)+sin(3.5*x) in [-3, 8]. f <- function(x) sin(1.2*x) + sin(3.5*x) shubert(function(x) -f(x), -3, 8, 5, 1e-04, 1000) ## $xopt ## [1] 3.216231 # 3.216209 ## $fopt ## [1] 1.623964 ## $nopt ## [1] 481 } \keyword{ optimize } pracma/man/movavg.Rd0000644000176200001440000001033214024777552014072 0ustar liggesusers\name{movavg} \alias{movavg} \title{ Moving Average Filters } \description{ Different types of moving average of a time series. } \usage{ movavg(x, n, type=c("s", "t", "w", "m", "e", "r")) } \arguments{ \item{x}{time series as numeric vector.} \item{n}{backward window length.} \item{type}{one of 's', 't', 'w', 'm', 'e', or 'r'; default is 's'.} } \details{ Types of available moving averages are: \itemize{ \item \code{s} for ``simple'', it computes the simple moving average. \code{n} indicates the number of previous data points used with the current data point when calculating the moving average. \item \code{t} for ``triangular'', it computes the triangular moving average by calculating the first simple moving average with window width of \code{ceil(n+1)/2}; then it calculates a second simple moving average on the first moving average with the same window size. \item \code{w} for ``weighted", it calculates the weighted moving average by supplying weights for each element in the moving window. Here the reduction of weights follows a linear trend. \item \code{m} for ``modified", it calculates the modified moving average. The first modified moving average is calculated like a simple moving average. Subsequent values are calculated by adding the new value and subtracting the last average from the resulting sum. \item \code{e} for``exponential", it computes the exponentially weighted moving average. The exponential moving average is a weighted moving average that reduces influences by applying more weight to recent data points () reduction factor \code{2/(n+1)}; or \item \code{r} for``running", this is an exponential moving average with a reduction factor of \code{1/n} [same as the modified average?]. } } \value{ Vector the same length as time series \code{x}. } \references{ Matlab Techdoc } \seealso{ \code{filter} } \examples{ \dontrun{ abbshares <- scan(file="") 25.69 25.89 25.86 26.08 26.41 26.90 26.27 26.45 26.49 26.08 26.11 25.57 26.02 25.53 25.27 25.95 25.19 24.78 24.96 24.63 25.68 25.24 24.87 24.71 25.01 25.06 25.62 25.95 26.08 26.25 25.91 26.61 26.34 25.55 25.36 26.10 25.63 25.52 24.74 25.00 25.38 25.01 24.57 24.95 24.89 24.13 23.83 23.94 23.74 23.12 23.13 21.05 21.59 19.59 21.88 20.59 21.59 21.86 22.04 21.48 21.37 19.94 19.49 19.46 20.34 20.59 19.96 20.18 20.74 20.83 21.27 21.19 20.27 18.83 19.46 18.90 18.09 17.99 18.03 18.50 19.11 18.94 18.21 18.06 17.66 16.77 16.77 17.10 17.62 17.22 17.95 17.08 16.42 16.71 17.06 17.75 17.65 18.90 18.80 19.54 19.23 19.48 18.98 19.28 18.49 18.49 19.08 19.63 19.40 19.59 20.37 19.95 18.81 18.10 18.32 19.02 18.78 18.68 19.12 17.79 18.10 18.64 18.28 18.61 18.20 17.82 17.76 17.26 17.08 16.70 16.68 17.68 17.70 18.97 18.68 18.63 18.80 18.81 19.03 18.26 18.78 18.33 17.97 17.60 17.72 17.79 17.74 18.37 18.24 18.47 18.75 18.66 18.51 18.71 18.83 19.82 19.71 19.64 19.24 19.60 19.77 19.86 20.23 19.93 20.33 20.98 21.40 21.14 21.38 20.89 21.08 21.30 21.24 20.55 20.83 21.57 21.67 21.91 21.66 21.53 21.63 21.83 21.48 21.71 21.44 21.67 21.10 21.03 20.83 20.76 20.90 20.92 20.80 20.89 20.49 20.70 20.60 20.39 19.45 19.82 20.28 20.24 20.30 20.66 20.66 21.00 20.88 20.99 20.61 20.45 20.09 20.34 20.61 20.29 20.20 20.00 20.41 20.70 20.43 19.98 19.92 19.77 19.23 19.55 19.93 19.35 19.66 20.27 20.10 20.09 20.48 19.86 20.22 19.35 19.08 18.81 18.87 18.26 18.27 17.91 17.68 17.73 17.56 17.20 17.14 16.84 16.47 16.45 16.25 16.07 plot(abbshares, type = "l", col = 1, ylim = c(15, 30), main = "Types of moving averages", sub = "Mid 2011--Mid 2012", xlab = "Days", ylab = "ABB Shares Price (in USD)") y <- movavg(abbshares, 50, "s"); lines(y, col = 2) y <- movavg(abbshares, 50, "t"); lines(y, col = 3) y <- movavg(abbshares, 50, "w"); lines(y, col = 4) y <- movavg(abbshares, 50, "m"); lines(y, col = 5) y <- movavg(abbshares, 50, "e"); lines(y, col = 6) y <- movavg(abbshares, 50, "r"); lines(y, col = 7) grid() legend(120, 29, c("original data", "simple", "triangular", "weighted", "modified", "exponential", "running"), col = 1:7, lty = 1, lwd = 1, box.col = "gray", bg = "white") } } \keyword{ timeseries } pracma/man/quiver.Rd0000644000176200001440000000166211567721641014111 0ustar liggesusers\name{quiver} \alias{quiver} \title{ Quiver or Velocity Plot } \description{ A quiver plot displays velocity vectors as arrows with components \code{(u,v)} at the points \code{(x,y)}. } \usage{ quiver(x, y, u, v, scale = 0.05, angle = 10, length = 0.1, ...) } \arguments{ \item{x, y}{x,y-coordinates of start points of the arrows.} \item{u, v}{x,y-coordinates of start points.} \item{scale}{scales the length of the arrows.} \item{angle}{angle between shaft and edge of the arrows.} \item{length}{length of the arrow edges.} \item{...}{more options presented to the \code{arrows} primitive.} } \details{ The matrices \code{x, y, u, v} must all be the same size and contain corresponding position and velocity components. However, x and y can also be vectors. } \value{ Opens a graph window and plots the velocity vectors. } \seealso{ \code{\link{vectorfield}}, \code{\link{arrows}} } \keyword{ graphs } pracma/man/rat.Rd0000644000176200001440000000167512042212424013347 0ustar liggesusers\name{rat} \alias{rat} \alias{rats} \title{ Continuous Fractions (Matlab Style) } \description{ Generate continuous fractions for numeric values. } \usage{ rat(x, tol = 1e-06) rats(x, tol = 1e-06) } \arguments{ \item{x}{a numeric scalar or vector.} \item{tol}{tolerance; default \code{1e-6} to make a nicer appearance for \code{pi}.} } \details{ \code{rat} generates continuous fractions, while \code{rats} prints the the corresponding rational representation and returns the numeric values. } \value{ \code{rat} returns a character vector of string representations of continuous fractions in the format \code{[b0; b1, ..., b_{n-1}]}. \code{rats} prints the rational number and returns a numeric vector. } \note{ Essentially, these functions apply \code{contfrac}. } \seealso{ \code{numbers::contfrac} } \examples{ rat(pi) rats(pi) rat(sqrt(c(2, 3, 5)), tol = 1e-15) rats(sqrt(c(2, 3, 5)), tol = 1e-15) } \keyword{ math } pracma/man/clear.Rd0000644000176200001440000000152012465405723013653 0ustar liggesusers\name{clear, who(s), ver} \alias{clear} \alias{ver} \alias{who} \alias{whos} \title{ Clear function (Matlab style) } \description{ List or remove items from workspace, or display system information. } \usage{ clear(lst) ver() who() whos() } \arguments{ \item{lst}{Character vector of names of variables in the global environment.} } \details{ Remove these or all items from the workspace, i.e. the global environment, and freeing up system memory. \code{who()} lists all items on the workspace.\cr \code{whos()} lists all items and their class and size. \code{ver()} displays version and license information for R and all the loaded packages. } \value{ Invisibly NULL. } \seealso{ \code{\link{ls}}, \code{\link{rm}}, \code{\link{sessionInfo}} } \examples{ # clear() # DON'T # who() # whos() # ver() } \keyword{ utilities } pracma/man/rk4.Rd0000644000176200001440000000401112031327377013260 0ustar liggesusers\name{rk4, rk4sys} \alias{rk4} \alias{rk4sys} \title{ Classical Runge-Kutta } \description{ Classical Runge-Kutta of order 4. } \usage{ rk4(f, a, b, y0, n) rk4sys(f, a, b, y0, n) } \arguments{ \item{f}{function in the differential equation \eqn{y' = f(x, y)};\cr defined as a function \eqn{R \times R^m \rightarrow R^m}, where \eqn{m} is the number of equations.} \item{a, b}{endpoints of the interval.} \item{y0}{starting values; for \eqn{m} equations \code{y0} needs to be a vector of length \code{m}.} \item{n}{the number of steps from \code{a} to \code{b}.} } \details{ Classical Runge-Kutta of order 4 for (systems of) ordinary differential equations with fixed step size. } \value{ List with components \code{x} for grid points between \code{a} and \code{b} and \code{y} an n-by-m matrix with solutions for variables in columns, i.e. each row contains one time stamp. } \references{ Fausett, L. V. (2007). Applied Numerical Analysis Using Matlab. Second edition, Prentice Hall. } \note{ This function serves demonstration purposes only. } \seealso{ \code{\link{ode23}}, \code{\link{deval}} } \examples{ ## Example1: ODE # y' = y*(-2*x + 1/x) for x != 0, 1 if x = 0 # solution is x*exp(-x^2) f <- function(x, y) { if (x != 0) dy <- y * (- 2*x + 1/x) else dy <- rep(1, length(y)) return(dy) } sol <- rk4(f, 0, 2, 0, 50) \dontrun{ x <- seq(0, 2, length.out = 51) plot(x, x*exp(-x^2), type = "l", col = "red") points(sol$x, sol$y, pch = "*") grid()} ## Example2: Chemical process f <- function(t, u) { u1 <- u[3] - 0.1 * (t+1) * u[1] u2 <- 0.1 * (t+1) * u[1] - 2 * u[2] u3 <- 2 * u[2] - u[3] return(c(u1, u2, u3)) } u0 <- c(0.8696, 0.0435, 0.0870) a <- 0; b <- 40 n <- 40 sol <- rk4sys(f, a, b, u0, n) \dontrun{ matplot(sol$x, sol$y, type = "l", lty = 1, lwd = c(2, 1, 1), col = c("darkred", "darkblue", "darkgreen"), xlab = "Time [min]", ylab= "Concentration [Prozent]", main = "Chemical composition") grid()} } \keyword{ ode } pracma/man/fprintf.Rd0000644000176200001440000000202212763544663014243 0ustar liggesusers\name{fprintf} \alias{fprintf} \title{ Formatted Printing (Matlab style) } \description{ Formatted printing to stdout or a file. } \usage{ fprintf(fmt, ..., file = "", append = FALSE) } \arguments{ \item{fmt}{a character vector of format strings.} \item{...}{values passed to the format string.} \item{file}{a connection or a character string naming the file to print to; default is "" which means standard output.} \item{append}{logical; shall the output be appended to the file; default is \code{FALSE}.} } \details{ \code{fprintf} applies the format string \code{fmt} to all input data \code{...} and writes the result to standard output or a file. The usual C-style string formatting commands are used- } \value{ Returns invisibly the number of bytes printed (using \code{nchar}). } \seealso{ \code{\link{sprintf}} } \examples{ ## Examples: nbytes <- fprintf("Results are:\n", file = "") for (i in 1:10) { fprintf("\%4d \%15.7f\n", i, exp(i), file = "") } } \keyword{ utilities } pracma/man/arnoldi.Rd0000644000176200001440000000335513116316453014220 0ustar liggesusers\name{arnoldi} \alias{arnoldi} \title{Arnoldi Iteration} \description{ Arnoldi iteration generates an orthonormal basis of the Krylov space and a Hessenberg matrix. } \usage{ arnoldi(A, q, m) } \arguments{ \item{A}{a square n-by-n matrix.} \item{q}{a vector of length n.} \item{m}{an integer.} } \details{ \code{arnoldi(A, q, m)} carries out \code{m} iterations of the Arnoldi iteration with n-by-n matrix \code{A} and starting vector \code{q} (which need not have unit 2-norm). For \code{m < n} it produces an n-by-(m+1) matrix \code{Q} with orthonormal columns and an (m+1)-by-m upper Hessenberg matrix \code{H} such that \code{A*Q[,1:m] = Q[,1:m]*H[1:m,1:m] + H[m+1,m]*Q[,m+1]*t(E_m)}, where \code{E_m} is the m-th column of the m-by-m identity matrix. } \value{ Returns a list with two elements: \code{Q} A matrix of orthonormal columns that generate the Krylov space {A, A q, A^2 q, ...}. \code{H} A Hessenberg matrix such that \code{A = Q * H * t(Q)}. } \references{ Nicholas J. Higham (2008). Functions of Matrices: Theory and Computation, SIAM, Philadelphia. } \seealso{ \code{\link{hessenberg}} } \examples{ A <- matrix(c(-149, -50, -154, 537, 180, 546, -27, -9, -25), nrow = 3, byrow = TRUE) a <- arnoldi(A, c(1,0,0)) a ## $Q ## [,1] [,2] [,3] ## [1,] 1 0.0000000 0.0000000 ## [2,] 0 0.9987384 -0.0502159 ## [3,] 0 -0.0502159 -0.9987384 ## ## $H ## [,1] [,2] [,3] ## [1,] -149.0000 -42.20367124 156.316506 ## [2,] 537.6783 152.55114875 -554.927153 ## [3,] 0.0000 0.07284727 2.448851 a$Q \%*\% a$H \%*\% t(a$Q) ## [,1] [,2] [,3] ## [1,] -149 -50 -154 ## [2,] 537 180 546 ## [3,] -27 -9 -25 } \keyword{ math } pracma/man/deconv.Rd0000644000176200001440000000164011563500200014026 0ustar liggesusers\name{deconv} \alias{deconv} \title{Deconvolution} \description{ Deconvolution and polynomial division. } \usage{ deconv(b, a) } \arguments{ \item{b, a}{real or complex vectors.} } \details{ \code{deconv(b,a)} deconvolves vector \code{a} out of vector \code{b}. The quotient is returned in vector \code{q} and the remainder in vector \code{r} such that \code{b = conv(a,q)+r}. If \code{b} and \code{a} are vectors of polynomial coefficients, convolving them is equivalent to multiplying the two polynomials, and deconvolution is polynomial division. } \value{ List with elements named \code{q} and \code{r}. } \note{ TODO: Base \code{deconv} on some \code{filter1d} function. } \seealso{ \code{\link{conv}}, \code{\link{polymul}} } \examples{ b <- c(10, 40, 100, 160, 170, 120) a <- c(1, 2, 3, 4) p <- deconv(b, a) p$q #=> 10 20 30 p$r #=> 0 0 0 } \keyword{ timeseries } pracma/man/cotes.Rd0000644000176200001440000000343111652316301013673 0ustar liggesusers\name{cotes} \alias{cotes} \title{ Newton-Cotes Formulas } \description{ Closed composite Newton-Cotes formulas of degree 2 to 8. } \usage{ cotes(f, a, b, n, nodes, ...) } \arguments{ \item{f}{the integrand as function of two variables.} \item{a, b}{lower and upper limit of the integral.} \item{n}{number of subintervals (grid points).} \item{nodes}{number of nodes in the Newton-Cotes formula.} \item{\ldots}{additional parameters to be passed to the function.} } \details{ 2 to 8 point closed and summed Newton-Cotes numerical integration formulas. These formulas are called `closed' as they include the endpoints. They are called `composite' insofar as they are combined with a Lagrange interpolation over subintervals. } \value{ The integral as a scalar. } \note{ It is generally recommended not to apply Newton-Cotes formula of degrees higher than 6, instead increase the number \code{n} of subintervals used. } \author{ Standard Newton-Cotes formulas can be found in every textbook. Copyright (c) 2005 Greg von Winckel of nicely vectorized Matlab code, available from MatlabCentral, for 2 to 11 grid points. R version by Hans W Borchers, with permission. } \references{ Quarteroni, A., R. Sacco, and F. Saleri (2007). Numerical Mathematics. Second Edition, Springer-Verlag, Berlin Heidelberg. } \seealso{ \code{\link{simpadpt}}, \code{\link{trapz}} } \examples{ cotes(sin, 0, pi/2, 20, 2) # 0.999485905248533 cotes(sin, 0, pi/2, 20, 3) # 1.000000211546591 cotes(sin, 0, pi/2, 20, 4) # 1.000000391824184 cotes(sin, 0, pi/2, 20, 5) # 0.999999999501637 cotes(sin, 0, pi/2, 20, 6) # 0.999999998927507 cotes(sin, 0, pi/2, 20, 7) # 1.000000000000363 odd degree is better cotes(sin, 0, pi/2, 20, 8) # 1.000000000002231 } \keyword{ math } pracma/man/nthroot.Rd0000644000176200001440000000137612042212424014254 0ustar liggesusers\name{nthroot} \alias{nthroot} \title{Real nth Root} \description{ Compute the real n-th root of real numbers. } \usage{ nthroot(x, n) } \arguments{ \item{x}{numeric vector or matrix} \item{n}{positive integer specifying the exponent \eqn{1/n}.} } \details{ Computes the n-th root real numbers of a numeric vector \code{x}, while \code{x^(1/n)} will return \code{NaN} for negative numbers, even in case \code{n} is odd. If some numbers in \code{x} are negative, \code{n} must be odd. (This is different in \emph{Octave}) } \value{ Returns a numeric vector of solutions to \eqn{x^{1/n}}. } \seealso{ \code{\link{sqrt}} } \examples{ nthroot(c(1, -2, 3), 3) #=> 1.000000 -1.259921 1.442250 (-2)^(1/3) #=> NaN } \keyword{ arith } pracma/man/qpspecial.Rd0000644000176200001440000000512013403535607014544 0ustar liggesusers\name{qpspecial, qpsolve} \alias{qpspecial} \alias{qpsolve} \title{ Special Quadratic Programming Solver } \description{ Solves a special Quadratic Programming problem. } \usage{ qpspecial(G, x, maxit = 100) qpsolve(d, A, b, meq = 0, tol = 1e-07) } \arguments{ \item{G}{\code{m x n}-matrix.} \item{x}{column vector of length \code{n}, the initial (feasible) iterate; if not present (or requirements on x0 not met), x0 will be found.} \item{maxit}{maximum number of iterates allowed; default 100.} \item{d}{Linear term of the quadratic form.} \item{A, b}{Linear equality and inequality constraints.} \item{meq}{First meq rows are used as equality constraints.} \item{tol}{Tolerance used for stopping the iteration.} } \details{ \code{qpspecial} solves the special QP problem: \code{min q(x) = || G*x ||_2^2 = x'*(G'*G)*x}\cr \code{s.t. sum(x) = 1}\cr \code{and x >= 0} The problem corresponds to finding the smallest vector (2-norm) in the convex hull of the columns of \code{G}. \code{qpsolve} solves the more general QP problem: \code{min q(x) = 0.5 t(x)*x - d x}\cr \code{s.t. A x >= b} with \code{A x = b} for the first \code{meq} rows. } \value{ Returns a list with the following components: \itemize{ \item \code{x} -- optimal point attaining optimal value; \item \code{d = G*x} -- smallest vector in the convex hull; \item \code{q} -- optimal value found, \code{= t(d) \%*\% d}; \item \code{niter} -- number of iterations used; \item \code{info} -- error number:\cr \code{= 0}: everything went well, q is optimal,\cr \code{= 1}: maxit reached and final x is feasible,\cr \code{= 2}: something went wrong. } } \note{ \code{x} may be missing, same as if requirements are not met; may stop with an error if \code{x} is not feasible. } \references{ [Has to be found.] } \author{ Matlab code by Anders Skajaa, 2010, under GPL license (HANSO toolbox); converted to R by Abhirup Mallik and Hans W. Borchers, with permission. } \examples{ G <- matrix(c(0.31, 0.99, 0.54, 0.20, 0.56, 0.97, 0.40, 0.38, 0.81, 0.06, 0.44, 0.80), 3, 4, byrow =TRUE) qpspecial(G) # $x # [,1] # [1,] 1.383697e-07 # [2,] 5.221698e-09 # [3,] 8.648168e-01 # [4,] 1.351831e-01 # $d # [,1] # [1,] 0.4940377 # [2,] 0.3972964 # [3,] 0.4886660 # $q # [1] 0.6407121 # $niter # [1] 6 # $info # [1] 0 # Example from quadprog::solve.QP d <- c(0,5,0) A <- matrix(c(-4,-3,0,2,1,0,0,-2,1),3,3) b <- c(-8,2,0) qpsolve(d, A, b) ## $sol ## [1] 0.4761905 1.0476190 2.0952381 ## $val ## [1] -2.380952 ## $niter ## [1] 3 } pracma/man/procrustes.Rd0000644000176200001440000000520212740250175014772 0ustar liggesusers\name{procrustes} \alias{procrustes} \alias{kabsch} \title{ Solving the Procrustes Problem } \description{ \code{procrustes} solves for two matrices \code{A} and \code{B} the `Procrustes Problem' of finding an orthogonal matrix \code{Q} such that \code{A-B*Q} has the minimal Frobenius norm. \code{kabsch} determines a best rotation of a given vector set into a second vector set by minimizing the weighted sum of squared deviations. The order of vectors is assumed fixed. } \usage{ procrustes(A, B) kabsch(A, B, w = NULL) } \arguments{ \item{A, B}{two numeric matrices of the same size.} \item{w}{weights , influence the distance of points} } \details{ The function \code{procrustes(A,B)} uses the \code{svd} decomposition to find an orthogonal matrix \code{Q} such that \code{A-B*Q} has a minimal Frobenius norm, where this norm for a matrix \code{C} is defined as \code{sqrt(Trace(t(C)*C))}, or \code{norm(C,'F')} in R. Solving it with \code{B=I} means finding a nearest orthogonal matrix. \code{kabsch} solves a similar problem and uses the Procrustes procedure for its purpose. Given two sets of points, represented as columns of the matrices \code{A} and \code{B}, it determines an orthogonal matrix \code{U} and a translation vector \code{R} such that \code{U*A+R-B} is minimal. } \value{ \code{procrustes} returns a list with components \code{P}, which is \code{B*Q}, then \code{Q}, the orthogonal matrix, and \code{d}, the Frobenius norm of \code{A-B*Q}. \code{kabsch} returns a list with \code{U} the orthogonal matrix applied, \code{R} the translation vector, and \code{d} the least root mean square between \code{U*A+R} and \code{B}. } \note{ The \code{kabsch} function does not take into account scaling of the sets, but this could easily be integrated. } \references{ Golub, G. H., and Ch. F. van Loan (1996). Matrix Computations. 3rd Edition, The John Hopkins University Press, Baltimore London. [Sect. 12.4, p. 601] Kabsch, W. (1976). A solution for the best rotation to relate two sets of vectors. Acta Cryst A, Vol. 32, p. 9223. } \seealso{ \code{\link{svd}} } \examples{ ## Procrustes U <- randortho(5) # random orthogonal matrix P <- procrustes(U, eye(5)) ## Kabsch P <- matrix(c(0, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 0, 0, 0, 1, 0, 1, 1, 1), nrow = 3, ncol = 8, byrow = TRUE) R <- c(1, 1, 1) phi <- pi/4 U <- matrix(c(1, 0, 0, 0, cos(phi), -sin(phi), 0, sin(phi), cos(phi)), nrow = 3, ncol = 3, byrow = TRUE) Q <- U \%*\% P + R K <- kabsch(P, Q) # K$R == R and K$U %*% P + c(K$R) == Q } \keyword{ array } pracma/man/lsqlincon.Rd0000644000176200001440000000540312634736623014577 0ustar liggesusers\name{lsqlincon} \alias{lsqlincon} \title{ Linear Least-Squares Fitting with linear constraints } \description{ Solves linearly constrained linear least-squares problems. } \usage{ lsqlincon(C, d, A = NULL, b = NULL, Aeq = NULL, beq = NULL, lb = NULL, ub = NULL) } \arguments{ \item{C}{\code{mxn}-matrix defining the least-squares problem.} \item{d}{vector or a one colum matrix with \code{m} rows} \item{A}{\code{pxn}-matrix for the linear inequality constraints.} \item{b}{vector or \code{px1}-matrix, right hand side for the constraints.} \item{Aeq}{\code{qxn}-matrix for the linear equality constraints.} \item{beq}{vector or \code{qx1}-matrix, right hand side for the constraints.} \item{lb}{lower bounds, a scalar will be extended to length n.} \item{ub}{upper bounds, a scalar will be extended to length n.} } \details{ \code{lsqlincon(C, d, A, b, Aeq, beq, lb, ub)} minimizes \code{||C*x - d||} (i.e., in the least-squares sense) subject to the following constraints: \code{A*x <= b}, \code{Aeq*x = beq}, and \code{lb <= x <= ub}. It applies the quadratic solver in \code{quadprog} with an active-set method for solving quadratic programming problems. If some constraints are \code{NULL} (the default), they will not be taken into account. In case no constraints are given at all, it simply uses \code{qr.solve}. } \value{ Returns the least-squares solution as a vector. } \note{ Function \code{lsqlin} in \code{pracma} solves this for equality constraints only, by computing a base for the nullspace of \code{Aeq}. But for linear inequality constraints there is no simple linear algebra `trick', thus a real optimization solver is needed. } \author{ HwB email: } \references{ Trefethen, L. N., and D. Bau III. (1997). Numerical Linear Algebra. SIAM, Society for Industrial and Applied Mathematics, Philadelphia. } \seealso{ \code{\link{lsqlin}}, \code{quadprog::solve.QP} } \examples{ ## MATLABs lsqlin example C <- matrix(c( 0.9501, 0.7620, 0.6153, 0.4057, 0.2311, 0.4564, 0.7919, 0.9354, 0.6068, 0.0185, 0.9218, 0.9169, 0.4859, 0.8214, 0.7382, 0.4102, 0.8912, 0.4447, 0.1762, 0.8936), 5, 4, byrow=TRUE) d <- c(0.0578, 0.3528, 0.8131, 0.0098, 0.1388) A <- matrix(c( 0.2027, 0.2721, 0.7467, 0.4659, 0.1987, 0.1988, 0.4450, 0.4186, 0.6037, 0.0152, 0.9318, 0.8462), 3, 4, byrow=TRUE) b <- c(0.5251, 0.2026, 0.6721) Aeq <- matrix(c(3, 5, 7, 9), 1) beq <- 4 lb <- rep(-0.1, 4) # lower and upper bounds ub <- rep( 2.0, 4) x <- lsqlincon(C, d, A, b, Aeq, beq, lb, ub) # -0.1000000 -0.1000000 0.1599088 0.4089598 # check A %*% x - b >= 0 # check Aeq %*% x - beq == 0 # check sum((C %*% x - d)^2) # 0.1695104 } \keyword{ optimize } pracma/man/hankel.Rd0000644000176200001440000000147612465405723014041 0ustar liggesusers\name{hankel} \alias{hankel} \title{Hankel Matrix} \description{ Generate Hankel matrix from column and row vector } \usage{ hankel(a, b) } \arguments{ \item{a}{vector that will be the first column} \item{b}{vector that if present will form the last row.} } \details{ \code{hankel(a)} returns the square Hankel matrix whose first column is \code{a} and whose elements are zero below the secondary diagonal. (I.e.: \code{b} may be missing.) \code{hankel(a, b)} returns a Hankel matrix whose first column is \code{a} and whose last row is \code{b}. If the first element of \code{b} differs from the last element of \code{a} it is overwritten by this one. } \value{ matrix of size \code{(length(a), length(b))} } \seealso{ \code{\link{Toeplitz}}, \code{\link{hadamard}} } \examples{ hankel(1:5, 5:1) } \keyword{ specmat } pracma/man/aitken.Rd0000644000176200001440000000212611556762673014055 0ustar liggesusers\name{aitken} \alias{aitken} \title{ Aitken' Method } \description{ Aitken's acceleration method. } \usage{ aitken(f, x0, nmax = 12, tol = 1e-8, ...) } \arguments{ \item{f}{Function with a fixpoint.} \item{x0}{Starting value.} \item{nmax}{Maximum number of iterations.} \item{tol}{Relative tolerance.} \item{...}{Additional variables passed to f.} } \details{ Aitken's acceleration method, or delta-squared process, is used for accelerating the rate of convergence of a sequence (from linear to quadratic), here applied to the fixed point iteration scheme of a function. } \value{ The fixpoint (as found so far). } \references{ Quarteroni, A., and F. Saleri (2006). Scientific Computing with Matlab and Octave. Second Edition, Springer-Verlag, Berlin Heidelberg. } \note{ Sometimes used to accerate Newton-Raphson (Steffensen's method). } \seealso{ \code{\link{lambertWp}} } \examples{ # Find a zero of f(x) = cos(x) - x*exp(x) # as fixpoint of phi(x) = x + (cos(x) - x*exp(x))/2 phi <- function(x) x + (cos(x) - x*exp(x))/2 aitken(phi, 0) #=> 0.5177574 } \keyword{ math } pracma/man/triquad.Rd0000644000176200001440000000431112116377305014234 0ustar liggesusers\name{triquad} \alias{triquad} \title{ Gaussian Triangle Quadrature } \description{ Numerically integrates a function over an arbitrary triangular domain by computing the Gauss nodes and weights. } \usage{ triquad(f, x, y, n = 10, tol = 1e-10, ...) } \arguments{ \item{f}{the integrand as function of two variables.} \item{x}{x-coordinates of the three vertices of the triangle.} \item{y}{y-coordinates of the three vertices of the triangle.} \item{n}{number of nodes.} \item{tol}{relative tolerance to be achieved.} \item{\ldots}{additional parameters to be passed to the function.} } \details{ Computes the \code{N^2} nodes and weights for a triangle with vertices given by 3x2 vector. The nodes are produced by collapsing the square to a triangle. Then \code{f} will be applied to the nodes and the result multiplied left and right with the weights (i.e., Gaussian quadrature). By default, the function applies Gaussian quadrature with number of nodes \code{n=10,21,43,87,175} until the relative error is smaller than the tolerance. } \value{ The integral as a scalar. } \note{ A small relative tolerance is \emph{not} really indicating a small absolute tolerance. } \author{ Copyright (c) 2005 Greg von Winckel Matlab code based on the publication mentioned and available from MatlabCentral (calculates nodes and weights). Translated to R (with permission) by Hans W Borchers. } \references{ Lyness, J. N., and R. Cools (1994). A Survey of Numerical Cubature over Triangles. Proceedings of the AMS Conference ``Mathematics of Computation 1943--1993'', Vancouver, CA. } \seealso{ \code{\link{quad2d}}, \code{\link{simpson2d}} } \examples{ x <- c(-1, 1, 0); y <- c(0, 0, 1) f1 <- function(x, y) x^2 + y^2 (I <- triquad(f1, x, y)) # 0.3333333333333333 # split the unit square x1 <- c(0, 1, 1); y1 <- c(0, 0, 1) x2 <- c(0, 1, 0); y2 <- c(0, 1, 1) f2 <- function(x, y) exp(x + y) I <- triquad(f2, x1, y1) + triquad(f2, x2, y2) # 2.952492442012557 quad2d(f2, 0, 1, 0, 1) # 2.952492442012561 simpson2d(f2, 0, 1, 0, 1) # 2.952492442134769 dblquad(f2, 0, 1, 0, 1) # 2.95249244201256 } \keyword{ math } pracma/man/toeplitz.Rd0000644000176200001440000000165512030655336014443 0ustar liggesusers\name{Toeplitz} \alias{Toeplitz} \title{Toeplitz Matrix} \description{ Generate Toeplitz matrix from column and row vector. } \usage{ Toeplitz(a, b) } \arguments{ \item{a}{vector that will be the first column} \item{b}{vector that if present will form the first row.} } \details{ \code{Toeplitz(a, b)} returns a (non-symmetric) Toeplitz matrix whose first column is \code{a} and whose first row is \code{b}. The following rows are shifted to the left. If the first element of \code{b} differs from the last element of \code{a} it is overwritten by this one (and a warning sent). } \value{ Matrix of size \code{(length(a), length(b))}. } \note{ \code{stats::Toeplitz} does not allow to specify the row vector, that is returns only the \emph{symmetric} Toeplitz matrix. } \seealso{ \code{\link{hankel}} } \examples{ Toeplitz(c(1, 2, 3, 4, 5)) Toeplitz(c(1, 2, 3, 4, 5), c(1.5, 2.5, 3.5, 4.5, 5.5)) } \keyword{ array } pracma/man/kriging.Rd0000644000176200001440000000502514000041732014202 0ustar liggesusers\name{kriging} \alias{kriging} \title{ Interpolation by Kriging } \description{ Simple and ordinary Kriging interpolation and interpolating function. } \usage{ kriging(u, v, u0, type = c("ordinary", "simple")) } \arguments{ \item{u}{an \code{nxm}-matrix of n points in the m-dimensional space.} \item{v}{an \code{n}-dim. (column) vector of interpolation values.} \item{u0}{a \code{kxm}-matrix of k points in \code{R^m} to be interpolated.} \item{type}{character; values `simple' or `ordinary'; no partial matching.} } \details{ Kriging is a geo-spatial estimation procedure that estimates points based on the variations of known points in a non-regular grid. It is especially suited for surfaces. } \note{ In the literature, different versions and extensions are discussed. } \value{ \code{kriging} returns a \code{k}-dim. vektor of interpolation values. } \references{ Press, W. H., A. A. Teukolsky, W. T. Vetterling, and B. P. Flannery (2007). Numerical recipes: The Art of Scientific Computing (3rd Ed.). Cambridge University Press, New York, Sect. 3.7.4, pp. 144-147. } \seealso{ \code{\link{akimaInterp}}, \code{\link{barylag2d}}, package \code{kriging} } \examples{ ## Interpolate the Saddle Point function f <- function(x) x[1]^2 - x[2]^2 # saddle point function set.seed(8237) n <- 36 x <- c(1, 1, -1, -1, runif(n-4, -1, 1)) # add four vertices y <- c(1, -1, 1, -1, runif(n-4, -1, 1)) u <- cbind(x, y) v <- numeric(n) for (i in 1:n) v[i] <- f(c(x[i], y[i])) kriging(u, v, c(0, 0)) #=> 0.006177183 kriging(u, v, c(0, 0), type = "simple") #=> 0.006229557 \dontrun{ xs <- linspace(-1, 1, 101) # interpolation on a diagonal u0 <- cbind(xs, xs) yo <- kriging(u, v, u0, type = "ordinary") # ordinary kriging ys <- kriging(u, v, u0, type = "simple") # simple kriging plot(xs, ys, type = "l", col = "blue", ylim = c(-0.1, 0.1), main = "Kriging interpolation along the diagonal") lines(xs, yo, col = "red") legend( -1.0, 0.10, c("simple kriging", "ordinary kriging", "function"), lty = c(1, 1, 1), lwd = c(1, 1, 2), col=c("blue", "red", "black")) grid() lines(c(-1, 1), c(0, 0), lwd = 2)} ## Find minimum of the sphere function f <- function(x, y) x^2 + y^2 + 100 v <- bsxfun(f, x, y) ff <- function(w) kriging(u, v, w) ff(c(0, 0)) #=> 100.0317 \dontrun{ optim(c(0.0, 0.0), ff) # $par: [1] 0.04490075 0.01970690 # $value: [1] 100.0291 ezcontour(ff, c(-1, 1), c(-1, 1)) points(0.04490075, 0.01970690, col = "red")} } \keyword{ fitting } pracma/man/reshape.Rd0000644000176200001440000000130212001565513014200 0ustar liggesusers\name{Reshape} \alias{Reshape} \title{Reshape Matrix} \description{ Reshape matrix or vector. } \usage{ Reshape(a, n, m) } \arguments{ \item{a}{matrix or vector} \item{n, m}{size of the result} } \details{ \code{Reshape(a, n, m)} returns the n-by-m matrix whose elements are taken column-wise from \code{a}. An error results if \code{a} does not have \code{n*m} elements. If \code{m} is missing, it will be calculated from \code{n} and the size of \code{a}. } \value{ Returns matrix (or array) of the requested size containing the elements of \code{a}. } \examples{ a <- matrix(1:12, nrow=4, ncol=3) Reshape(a, 6, 2) Reshape(a, 6) # the same Reshape(a, 3, 4) } \keyword{array} pracma/man/ndims.Rd0000644000176200001440000000155613630250433013677 0ustar liggesusers\name{ndims} \alias{ndims} \title{Number of Dimensions} \description{ Number of matrix or array dimensions. } \usage{ ndims(x) } \arguments{ \item{x}{a vector, matrix, array, or list} } \details{ Returns the number of dimensions as \code{length(x)}. For an empty object its dimension is 0, for vectors it is 1 (deviating from MATLAB), for matrices it is 2, and for arrays it is the number of dimensions, as usual. Lists are considered to be (one-dimensional) vectors. } \value{ the number of dimensions in a vector, matrix, or array \code{x}. } \seealso{ \code{\link{size}} } \note{ The result will differ from Matlab when \code{x} is a vector. } \examples{ ndims(c()) # 0 ndims(as.numeric(1:8)) # 1 ndims(list(a=1, b=2, c=3)) # 1 ndims(matrix(1:12, 3, 4)) # 2 ndims(array(1:8, c(2,2,2))) # 3 } \keyword{array} pracma/man/arclength.Rd0000644000176200001440000000705412660356064014544 0ustar liggesusers\name{arclength} \alias{arclength} \title{ Arc Length of a Curve } \description{ Calculates the arc length of a parametrized curve. } \usage{ arclength(f, a, b, nmax = 20, tol = 1e-05, ...) } \arguments{ \item{f}{parametrization of a curve in n-dim. space.} \item{a,b}{begin and end of the parameter interval.} \item{nmax}{maximal number of iterations.} \item{tol}{relative tolerance requested.} \item{...}{additional arguments to be passed to the function.} } \details{ Calculates the arc length of a parametrized curve in \code{R^n}. It applies Richardson's extrapolation by refining polygon approximations to the curve. The parametrization of the curve must be vectorized: if \code{t-->F(t)} is the parametrization, \code{F(c(t1,t1,...))} must return \code{c(F(t1),F(t2),...)}. Can be directly applied to determine the arc length of a one-dimensional function \code{f:R-->R} by defining \code{F} (if \code{f} is vectorized) as \code{F:t-->c(t,f(t))}. } \value{ Returns a list with components \code{length} the calculated arc length, \code{niter} the number of iterations, and \code{rel.err} the relative error generated from the extrapolation. } \author{ HwB } \note{ If by chance certain equidistant points of the curve lie on a straight line, the result may be wrong, then use \code{polylength} below. } \seealso{ \code{\link{poly_length}} } \examples{ ## Example: parametrized 3D-curve with t in 0..3*pi f <- function(t) c(sin(2*t), cos(t), t) arclength(f, 0, 3*pi) # $length: 17.22203 # true length 17.222032... ## Example: length of the sine curve f <- function(t) c(t, sin(t)) arclength(f, 0, pi) # true length 3.82019... ## Example: Length of an ellipse with axes a = 1 and b = 0.5 # parametrization x = a*cos(t), y = b*sin(t) a <- 1.0; b <- 0.5 f <- function(t) c(a*cos(t), b*sin(t)) L <- arclength(f, 0, 2*pi, tol = 1e-10) #=> 4.84422411027 # compare with elliptic integral of the second kind e <- sqrt(1 - b^2/a^2) # ellipticity L <- 4 * a * ellipke(e^2)$e #=> 4.84422411027 \dontrun{ ## Example: oscillating 1-dimensional function (from 0 to 5) f <- function(x) x * cos(0.1*exp(x)) * sin(0.1*pi*exp(x)) F <- function(t) c(t, f(t)) L <- arclength(F, 0, 5, tol = 1e-12, nmax = 25) print(L$length, digits = 16) # [1] 82.81020372882217 # true length 82.810203728822172... # Split this computation in 10 steps (run time drops from 2 to 0.2 secs) L <- 0 for (i in 1:10) L <- L + arclength(F, (i-1)*0.5, i*0.5, tol = 1e-10)$length print(L, digits = 16) # [1] 82.81020372882216 # Alternative calculation of arc length f1 <- function(x) sqrt(1 + complexstep(f, x)^2) L1 <- quadgk(f1, 0, 5, tol = 1e-14) print(L1, digits = 16) # [1] 82.81020372882216 } \dontrun{ #-- -------------------------------------------------------------------- # Arc-length parametrization of Fermat's spiral #-- -------------------------------------------------------------------- # Fermat's spiral: r = a * sqrt(t) f <- function(t) 0.25 * sqrt(t) * c(cos(t), sin(t)) t1 <- 0; t2 <- 6*pi a <- 0; b <- arclength(f, t1, t2)$length fParam <- function(w) { fct <- function(u) arclength(f, a, u)$length - w urt <- uniroot(fct, c(a, 6*pi)) urt$root } ts <- linspace(0, 6*pi, 250) plot(matrix(f(ts), ncol=2), type='l', col="blue", asp=1, xlab="", ylab = "", main = "Fermat's Spiral", sub="20 subparts of equal length") for (i in seq(0.05, 0.95, by=0.05)) { v <- fParam(i*b); fv <- f(v) points(fv[1], f(v)[2], col="darkred", pch=20) } } } \keyword{ math } pracma/man/pow2.Rd0000644000176200001440000000130612042212424013437 0ustar liggesusers\name{pow2} \alias{pow2} \title{Base 2 Power} \description{ Power with base 2. } \usage{ pow2(f, e) } \arguments{ \item{f}{numeric vector of factors} \item{e}{numeric vector of exponents for base 2} } \details{ Computes the expression \code{f * 2^e}, setting \code{e} to \code{f} and \code{f} to 1 in case \code{e} is missing. Complex values are only processed if \code{e} is missing. } \value{ Returns a numeric vector computing \eqn{f\,2^e}. } \seealso{ \code{\link{nextpow2}} } \examples{ pow2(c(0, 1, 2, 3)) #=> 1 2 4 8 pow2(c(0, -1, 2, 3), c(0,1,-2,3)) #=> 0.0 -2.0 0.5 24.0 pow2(1i) #=> 0.7692389+0.6389613i } \keyword{ arith } pracma/man/nullspace.Rd0000644000176200001440000000334212060137756014556 0ustar liggesusers\name{nullspace} \alias{nullspace} \alias{null} \title{ Kernel or Nullspace } \description{ Kernel of the linear map defined by matrix \code{M}. } \usage{ nullspace(M) null(M) } \arguments{ \item{M}{Numeric matrix; vectors will be considered as column vectors.} } \details{ The kernel (aka null space/nullspace) of a matrix \code{M} is the set of all vectors \code{x} for which \code{Ax=0}. It is computed from the QR-decomposition of the matrix. \code{null} is simply an alias for \code{nullspace} -- and the Matlab name. } \value{ If \code{M} is an \code{n}-by-\code{m} (operating from left on \code{m}-dimensional column vectors), then \code{N=nullspace(M)} is a \code{m}-by-\code{k} matrix whose columns define a (linearly independent) basis of the \code{k}-dimensional kernel in \code{R^m}. If the kernel is only the null vector \code{(0 0 ... 0)}, then NULL will be returned. As the rank of a matrix is also the dimension of its image, the following relation is true: \code{m = dim(nullspace(M)) + rank(M)} } \references{ Trefethen, L. N., and D. Bau III. (1997). Numerical Linear Algebra. SIAM, Philadelphia. } \note{ The image of \code{M} can be retrieved from \code{orth()}. } \seealso{ \code{\link{Rank}}, \code{\link{orth}}, \code{MASS::Null} } \examples{ M <- matrix(1:12, 3, 4) Rank(M) #=> 2 N <- nullspace(M) # [,1] [,2] [,3] # [1,] 0.4082483 -0.8164966 0.4082483 M %*% N # almost c(0, 0, 0) M1 <- matrix(1:6, 2, 3) # of rank 2 M2 <- t(M1) nullspace(M1) # corresponds to 1 -2 1 nullspace(M2) # NULL, i.e. 0 0 M <- magic(5) Rank(M) #=> 5 nullspace(M) #=> NULL, i.e. 0 0 0 0 0 } \keyword{ array } pracma/man/ode.Rd0000644000176200001440000001177714000041732013332 0ustar liggesusers\name{ode23} \alias{ode23} \alias{ode23s} \alias{ode45} \alias{ode78} \title{ Non-stiff (and stiff) ODE solvers } \description{ Runge-Kutta (2, 3)-method with variable step size, resp. (4,5)-method with Dormand-Price coefficients, or (7,8)-pairs with Fehlberg coefficients. The function \code{f(t, y)} has to return the derivative as a column vector. } \usage{ ode23(f, t0, tfinal, y0, ..., rtol = 1e-3, atol = 1e-6) ode23s(f, t0, tfinal, y0, jac = NULL, ..., rtol = 1e-03, atol = 1e-06, hmax = 0.0) ode45(f, t0, tfinal, y0, ..., atol = 1e-6, hmax = 0.0) ode78(f, t0, tfinal, y0, ..., atol = 1e-6, hmax = 0.0) } \arguments{ \item{f}{function in the differential equation \eqn{y' = f(x, y)};\cr defined as a function \eqn{R \times R^m \rightarrow R^m}, where \eqn{m} is the number of equations.} \item{t0, tfinal}{start and end points of the interval.} \item{y0}{starting values as column vector; for \eqn{m} equations \code{u0} needs to be a vector of length \code{m}.} \item{jac}{jacobian of \code{f} as a function of \code{x} alone; if not specified, a finite difference approximation will be used.} \item{rtol, atol}{relative and absolute tolerance.} \item{hmax}{maximal step size, default is \code{(tfinal - t0)/10.}} \item{...}{Additional parameters to be passed to the function.} } \details{ \code{ode23} is an integration method for systems of ordinary differential equations using second and third order Runge-Kutta-Fehlberg formulas with automatic step-size. \code{ode23s} can be used to solve a stiff system of ordinary differential equations, based on a modified Rosenbrock triple method of order (2,3); See section 4.1 in [Shampine and Reichelt]. \code{ode45} implements Dormand-Prince (4,5) pair that minimizes the local truncation error in the 5th-order estimate which is what is used to step forward (local extrapolation). Generally it produces more accurate results and costs roughly the same computationally. \code{ode78} implements Fehlberg's (7,8) pair and is a 7th-order accurate integrator therefore the local error normally expected is O(h^8). However, because this particular implementation uses the 8th-order estimate for xout (i.e. local extrapolation) moving forward with the 8th-order estimate will yield errors on the order of O(h^9). It requires 13 function evaluations per integration step. } \value{ List with components \code{t} for grid (or `time') points between \code{t0} and \code{tfinal}, and \code{y} an n-by-m matrix with solution variables in columns, i.e. each row contains one time stamp. } \references{ Ascher, U. M., and L. R. Petzold (1998). Computer Methods for Ordinary Differential Equations and Differential-Algebraic Equations. SIAM. L.F. Shampine and M.W. Reichelt (1997). The MATLAB ODE Suite. SIAM Journal on Scientific Computing, Vol. 18, pp. 1-22. Moler, C. (2004). Numerical Computing with Matlab. Revised Reprint, SIAM. \url{https://www.mathworks.com/moler/chapters.html}. } \note{ Copyright (c) 2004 C. Moler for the Matlab textbook version \code{ode23tx}. } \seealso{ \code{\link{rk4sys}}, \code{\link{deval}} } \examples{ ## Example1: Three-body problem f <- function(t, y) as.matrix(c(y[2]*y[3], -y[1]*y[3], 0.51*y[1]*y[2])) y0 <- as.matrix(c(0, 1, 1)) t0 <- 0; tf <- 20 sol <- ode23(f, t0, tf, y0, rtol=1e-5, atol=1e-10) \dontrun{ matplot(sol$t, sol$y, type = "l", lty = 1, lwd = c(2, 1, 1), col = c("darkred", "darkblue", "darkgreen"), xlab = "Time [min]", ylab= "", main = "Three-body Problem") grid()} ## Example2: Van der Pol Equation # x'' + (x^2 - 1) x' + x = 0 f <- function(t, x) as.matrix(c(x[1] * (1 - x[2]^2) -x[2], x[1])) t0 <- 0; tf <- 20 x0 <- as.matrix(c(0, 0.25)) sol <- ode23(f, t0, tf, x0) \dontrun{ plot(c(0, 20), c(-3, 3), type = "n", xlab = "Time", ylab = "", main = "Van der Pol Equation") lines(sol$t, sol$y[, 1], col = "blue") lines(sol$t, sol$y[, 2], col = "darkgreen") grid()} ## Example3: Van der Pol as stiff equation vdP <- function(t,y) as.matrix(c(y[2], 10*(1-y[1]^2)*y[2]-y[1])) ajax <- function(t, y) matrix(c(0, 1, -20*y[1]*y[2]-1, 10*(1-y[1]^2)), 2,2, byrow = TRUE) sol <- ode23s(vdP, t0, tf, c(2, 0), jac = ajax, hmax = 1.0) \dontrun{ plot(sol$t, sol$y[, 1], col = "blue") lines(sol$t, sol$y[, 1], col = "blue") lines(sol$t, sol$y[, 2]/8, col = "red", lwd = 2) grid()} ## Example4: pendulum m = 1.0; l = 1.0 # [kg] resp. [m] g = 9.81; b = 0.7 # [m/s^2] resp. [N s/m] fp = function(t, x) c( x[2] , 1/(1/3*m*l^2)*(-b*x[2]-m*g*l/2*sin(x[1])) ) t0 <- 0.0; tf <- 5.0; hmax = 0.1 y0 = c(30*pi/180, 0.0) sol = ode45(fp, t0, tf, y0, hmax = 0.1) \dontrun{ matplot(sol$t, sol$y, type = "l", lty = 1) grid()} ## Example: enforced pendulum g <- 9.81 L <- 1.0; Y <- 0.25; w <- 2.5 f <- function(t, y) { as.matrix(c(y[2], -g/L * sin(y[1]) + w^2/L * Y * cos(y[1]) * sin(w*t))) } y0 <- as.matrix(c(0, 0)) sol <- ode78(f, 0.0, 60.0, y0, hmax = 0.05) \dontrun{ plot(sol$t, sol$y[, 1], type="l", col="blue") grid()} } \keyword{ ode } pracma/man/cutpoints.Rd0000644000176200001440000000426412042212424014606 0ustar liggesusers\name{cutpoints} \alias{cutpoints} \title{ Find Cutting Points } \description{ Finds cutting points for vector s of real numbers. } \usage{ cutpoints(x, nmax = 8, quant = 0.95) } \arguments{ \item{x}{vector of real values.} \item{nmax}{the maximum number of cutting points to choose} \item{quant}{quantile of the gaps to consider for cuts.} } \details{ Finds cutting points for vector s of real numbers, based on the gaps in the values of the vector. The number of cutting points is derived from a quantile of gaps in the values. The user can set a lower limit for this number of gaps. } \value{ Returns a list with components \code{cutp}, the cutting points selected, and \code{cutd}, the gap between values of \code{x} at this cutting point. } \note{ Automatically finding cutting points is often requested in Data Mining. If a target attribute is available, Quinlan's C5.0 does a very good job here. Unfortunately, the `C5.0' package (of the R-Forge project ``Rulebased Models'') is quite cumbersome to use. } \references{ Witten, I. H., and E. Frank (2005). Data Mining: Practical Machine Learning Tools and Techniques. Morgan Kaufmann Publishers, San Francisco. } \seealso{ \code{\link{cut}} } \examples{ N <- 100; x <- sort(runif(N)) cp <- cutpoints(x, 6, 0.9) n <- length(cp$cutp) # Print out nocp <- rle(findInterval(x, c(-Inf, cp$cutp, Inf)))$lengths cbind(c(-Inf, cp$cutp), c(cp$cutp, Inf), nocp) # Define a factor from the cutting points fx <- cut(x, breaks = c(-Inf, cp$cutp, Inf)) \dontrun{ # Plot points and cutting points plot(x, rep(0, N), col="gray", ann = FALSE) points(cp$cutp, rep(0, n), pch="|", col=2) # Compare with k-means clustering km <- kmeans(x, n) points(x, rep(0, N), col = km$cluster, pch = "+") ## A 2-dimensional example x <- y <- c() for (i in 1:9) { for (j in 1:9) { x <- c(x, i + rnorm(20, 0, 0.2)) y <- c(y, j + rnorm(20, 0, 0.2)) } } cpx <- cutpoints(x, 8, 0) cpy <- cutpoints(y, 8, 0) plot(x, y, pch = 18, col=rgb(0.5,0.5,0.5), axes=FALSE, ann=FALSE) for (xi in cpx$cutp) abline(v=xi, col=2, lty=2) for (yi in cpy$cutp) abline(h=yi, col=2, lty=2) km <- kmeans(cbind(x, y), 81) points(x, y, col=km$cluster) } } \keyword{ timeseries } pracma/man/romberg.Rd0000644000176200001440000000305312337613220014214 0ustar liggesusers\name{romberg} \alias{romberg} \title{ Romberg Integration } \description{ Romberg Integration } \usage{ romberg(f, a, b, maxit = 25, tol = 1e-12, ...) } \arguments{ \item{f}{function to be integrated.} \item{a, b}{end points of the interval.} \item{maxit}{maximum number of iterations.} \item{tol}{requested tolerance.} \item{...}{variables to be passed to the function.} } \details{ Simple Romberg integration with an explicit Richardson method applied to a series of trapezoidal integrals. This scheme works best with smooth and non-oscillatory functions and needs the least number of function calls among all integration routines. The function does \emph{not} need to be vectorized. } \value{ List of value, number or iterations, and relative error. } \references{ Chapra, S. C., and R. P. Canale (2006). Numerical Methods for Engineers. Fifth Edition, McGraw-Hill, New York. } \note{ Using a trapezoid formula Romberg integration will use \code{2*(2^iter-1)+iter} function calls. By remembering function values this could be reduced to \code{2^iter+1} calls. } \seealso{ \code{\link{integrate}}, \code{\link{quadgr}} } \examples{ romberg(sin, 0, pi, tol = 1e-15) # 2 , rel.error 1e-15 romberg(exp, 0, 1, tol = 1e-15) # 1.718281828459044 , rel error 1e-15 # 1.718281828459045 , i.e. exp(1) - 1 f <- function(x, p) sin(x) * cos(p*x) romberg(f, 0, pi, p = 2) # 2/3 , abs.err 1.5e-14 # value: -0.6666667, iter: 7, rel.error: 1e-12 } \keyword{ math } pracma/man/lu.Rd0000644000176200001440000000500112425377750013207 0ustar liggesusers\name{lu} \alias{lu} \alias{lufact} \alias{lusys} \title{ LU Matrix Factorization } \description{ LU decomposition of a positive definite matrix as Gaussian factorization. } \usage{ lu(A, scheme = c("kji", "jki", "ijk")) lufact(A) lusys(A, b) } \arguments{ \item{A}{square positive definite numeric matrix (will not be checked).} \item{scheme}{order of row and column operations.} \item{b}{right hand side of a linear system of equations.} } \details{ For a given matrix \code{A}, the LU decomposition exists and is unique iff its principal submatrices of order \code{i=1,...,n-1} are nonsingular. The procedure here is a simple Gauss elimination with or without pivoting. The scheme abbreviations refer to the order in which the cycles of row- and column-oriented operations are processed. The ``ijk'' scheme is one of the two compact forms, here the Doolite factorization (the Crout factorization would be similar). \code{lufact} applies partial pivoting (along the rows). \code{lusys} uses LU factorization to solve the linear system \code{A*x=b}. } \value{ \code{lu} returns a list with components \code{L} and \code{U}, the two lower and upper triangular matrices such that \code{A=L\%*\%U}. \code{lufact} returns a list with \code{L} and \code{U} combined into one matrix \code{LU}, the \code{rows} used in partial pivoting, and \code{det} representing the determinant of \code{A}. See the examples how to extract matrices \code{L} and \code{U} from \code{LU}. \code{lusys} returns the solution of the system as a column vector. } \references{ Quarteroni, A., R. Sacco, and F. Saleri (2007). Numerical Mathematics. Second edition, Springer-Verlag, Berlin Heidelberg. J.H. Mathews and K.D. Fink (2003). Numerical Methods Using MATLAB. Fourth Edition, Pearson (Prentice-Hall), updated 2006. } \note{ This function is not meant to process huge matrices or linear systems of equations. Without pivoting it may also be harmed by considerable inaccuracies. } \seealso{ \code{\link{qr}} } \examples{ A <- magic(5) D <- lu(A, scheme = "ijk") # Doolittle scheme D$L \%*\% D$U ## [,1] [,2] [,3] [,4] [,5] ## [1,] 17 24 1 8 15 ## [2,] 23 5 7 14 16 ## [3,] 4 6 13 20 22 ## [4,] 10 12 19 21 3 ## [5,] 11 18 25 2 9 H4 <- hilb(4) lufact(H4)$det ## [1] 0.0000001653439 x0 <- c(1.0, 4/3, 5/3, 2.0) b <- H4 \%*\% x0 lusys(H4, b) ## [,1] ## [1,] 1.000000 ## [2,] 1.333333 ## [3,] 1.666667 ## [4,] 2.000000 } \keyword{ array } pracma/man/brown72.Rd0000644000176200001440000000110214000041732014040 0ustar liggesusers\name{brown72} \alias{brown72} \docType{data} \title{ Brownian Motion } \description{ The Brown72 data set represents a fractal Brownian motion with a prescribed Hurst exponent 0f 0.72 . } \usage{ data(brown72) } \format{ The format is: one column. } \details{ Estimating the Hurst exponent for a data set provides a measure of whether the data is a pure random walk or has underlying trends. Brownian walks can be generated from a defined Hurst exponent. } \examples{ \dontrun{ data(brown72) plot(brown72, type = "l", col = "blue") grid()} } \keyword{ datasets } pracma/man/fornberg.Rd0000644000176200001440000000311112064403271014356 0ustar liggesusers\name{fornberg} \alias{fornberg} \title{ Fornberg's Finite Difference Approximation } \description{ Finite difference approximation using Fornberg's method for the derivatives of order 1 to k based on irregulat grid values. } \usage{ fornberg(x, y, xs, k = 1) } \arguments{ \item{x}{grid points on the x-axis, must be distinct.} \item{y}{discrete values of the function at the grid points.} \item{xs}{point at which to approximate (not vectorized).} \item{k}{order of derivative, \code{k<=length(x)-1} required.} } \details{ Compute coefficients for finite difference approximation for the derivative of order \code{k} at \code{xs} based on grid values at points in \code{x}. For \code{k=0} this will evaluate the interpolating polynomial itself, but call it with \code{k=1}. } \value{ Returns a matrix of size \code{(length(xs))}, where the (k+1)-th column gives the value of the k-th derivative. Especially the first column returns the polynomial interpolation of the function. } \note{ Fornberg's method is considered to be numerically more stable than applying Vandermonde's matrix. } \references{ LeVeque, R. J. (2007). Finite Difference Methods for Ordinary and Partial Differential Equations. Society for Industrial and Applied Mathematics (SIAM), Philadelphia. } \seealso{ \code{\link{neville}}, \code{\link{newtonInterp}} } \examples{ x <- 2 * pi * c(0.0, 0.07, 0.13, 0.2, 0.28, 0.34, 0.47, 0.5, 0.71, 0.95, 1.0) y <- sin(0.9*x) xs <- linspace(0, 2*pi, 51) fornb <- fornberg(x, y, xs, 10) \dontrun{ matplot(xs, fornb, type="l") grid()} } \keyword{ fitting } pracma/man/bernoulli.Rd0000755000176200001440000000427312542737347014601 0ustar liggesusers\name{bernoulli} \alias{bernoulli} \title{ Bernoulli Numbers and Polynomials } \description{ The Bernoulli numbers are a sequence of rational numbers that play an important role for the series expansion of hyperbolic functions, in the Euler-MacLaurin formula, or for certain values of Riemann's function at negative integers. } \usage{ bernoulli(n, x) } \arguments{ \item{n}{the index, a whole number greater or equal to 0.} \item{x}{real number or vector of real numbers; if missing, the Bernoulli numbers will be given, otherwise the polynomial.} } \details{ The calculation of the Bernoulli numbers uses the values of the zeta function at negative integers, i.e. \eqn{B_n = -n \, zeta(1-n)}. Bernoulli numbers \eqn{B_n} for odd \code{n} are 0 except \eqn{B_1} which is set to -0.5 on purpose. The Bernoulli polynomials can be directly defined as \deqn{ B_n(x) = \sum_{k=0}^n {n \choose k} b_{n-k}\, x^k } and it is immediately clear that the Bernoulli numbers are then given as \eqn{B_n = B_n(0)}. } \value{ Returns the first \code{n+1} Bernoulli numbers, if \code{x} is missing, or the value of the Bernoulli polynomial at point(s) \code{x}. } \references{ See the entry on Bernoulli numbers in the Wikipedia. } \note{ The definition uses \code{B_1 = -1/2} in accordance with the definition of the Bernoulli polynomials. } \seealso{ \code{\link{zeta}} } \examples{ bernoulli(10) # 1.00000000 -0.50000000 0.16666667 0.00000000 -0.03333333 # 0.00000000 0.02380952 0.00000000 -0.03333333 0.00000000 0.07575758 # \dontrun{ x1 <- linspace(0.3, 0.7, 2) y1 <- bernoulli(1, x1) plot(x1, y1, type='l', col='red', lwd=2, xlim=c(0.0, 1.0), ylim=c(-0.2, 0.2), xlab="", ylab="", main="Bernoulli Polynomials") grid() xs <- linspace(0, 1, 51) lines(xs, bernoulli(2, xs), col="green", lwd=2) lines(xs, bernoulli(3, xs), col="blue", lwd=2) lines(xs, bernoulli(4, xs), col="cyan", lwd=2) lines(xs, bernoulli(5, xs), col="brown", lwd=2) lines(xs, bernoulli(6, xs), col="magenta", lwd=2) legend(0.75, 0.2, c("B_1", "B_2", "B_3", "B_4", "B_5", "B_6"), col=c("red", "green", "blue", "cyan", "brown", "magenta"), lty=1, lwd=2) } } \keyword{ specfun } pracma/man/invlap.Rd0000644000176200001440000000536712042212424014054 0ustar liggesusers\name{invlap} \alias{invlap} \title{ Inverse Laplacian } \description{ Numerical inversion of Laplace transforms. } \usage{ invlap(Fs, t1, t2, nnt, a = 6, ns = 20, nd = 19) } \arguments{ \item{Fs}{function representing the function to be inverse-transformed.} \item{t1, t2}{end points of the interval.} \item{nnt}{number of grid points between t1 and t2.} \item{a}{shift parameter; it is recommended to preserve value 6.} \item{ns, nd}{further parameters, increasing them leads to lower error.} } \details{ The transform Fs may be any reasonable function of a variable s^a, where a is a real exponent. Thus, the function \code{invlap} can solve fractional problems and invert functions Fs containing (ir)rational or transcendental expressions. } \value{ Returns a list with components \code{x} the x-coordinates and \code{y} the y-coordinates representing the original function in the interval \code{[t1,t2]}. } \note{ Based on a presentation in the first reference. The function \code{invlap} on MatlabCentral (by ) served as guide. The Talbot procedure from the second reference could be an interesting alternative. } \references{ J. Valsa and L. Brancik (1998). Approximate Formulae for Numerical Inversion of Laplace Transforms. Intern. Journal of Numerical Modelling: Electronic Networks, Devices and Fields, Vol. 11, (1998), pp. 153-166. L.N.Trefethen, J.A.C.Weideman, and T.Schmelzer (2006). Talbot quadratures and rational approximations. BIT. Numerical Mathematics, 46(3):653--670. } \examples{ Fs <- function(s) 1/(s^2 + 1) # sine function Li <- invlap(Fs, 0, 2*pi, 100) \dontrun{ plot(Li[[1]], Li[[2]], type = "l", col = "blue"); grid() Fs <- function(s) tanh(s)/s # step function L1 <- invlap(Fs, 0.01, 20, 1000) plot(L1[[1]], L1[[2]], type = "l", col = "blue") L2 <- invlap(Fs, 0.01, 20, 2000, 6, 280, 59) lines(L2[[1]], L2[[2]], col="darkred"); grid() Fs <- function(s) 1/(sqrt(s)*s) L1 <- invlap(Fs, 0.01, 5, 200, 6, 40, 20) plot(L1[[1]], L1[[2]], type = "l", col = "blue"); grid() Fs <- function(s) 1/(s^2 - 1) # hyperbolic sine function Li <- invlap(Fs, 0, 2*pi, 100) plot(Li[[1]], Li[[2]], type = "l", col = "blue"); grid() Fs <- function(s) 1/s/(s + 1) # exponential approach Li <- invlap(Fs, 0, 2*pi, 100) plot(Li[[1]], Li[[2]], type = "l", col = "blue"); grid() gamma <- 0.577215664901532 # Euler-Mascheroni constant Fs <- function(s) -1/s * (log(s)+gamma) # natural logarithm Li <- invlap(Fs, 0, 2*pi, 100) plot(Li[[1]], Li[[2]], type = "l", col = "blue"); grid() Fs <- function(s) (20.5+3.7343*s^1.15)/(21.5+3.7343*s^1.15+0.8*s^2.2+0.5*s^0.9)/s L1 <- invlap(Fs, 0.01, 5, 200, 6, 40, 20) plot(L1[[1]], L1[[2]], type = "l", col = "blue") grid()} } \keyword{ timeseries } pracma/man/isempty.Rd0000644000176200001440000000057711540452742014266 0ustar liggesusers\name{isempty} \alias{isempty} \title{isempty Property} \description{ Determine if an object is empty. } \usage{ isempty(x) } \arguments{ \item{x}{an R object} } \details{ An empty object has length zero. } \value{ \code{TRUE} if \code{x} has length 0; otherwise, \code{FALSE}. } \examples{ isempty(c(0)) # FALSE isempty(matrix(0, 1, 0)) # TRUE } \keyword{logic} pracma/man/pade.Rd0000644000176200001440000000356612042212424013473 0ustar liggesusers\name{pade} \alias{pade} \title{ Pade Approximation } \description{ A Pade approximation is a rational function (of a specified order) whose power series expansion agrees with a given function and its derivatives to the highest possible order. } \usage{ pade(p1, p2 = c(1), d1 = 5, d2 = 5) } \arguments{ \item{p1}{polynomial representing or approximating the function, preferably the Taylor series of the function around some point.} \item{p2}{if present, the function is given as \code{p1/p2}.} \item{d1}{the degree of the numerator of the rational function.} \item{d2}{the degree of the denominator of the rational function.} } \details{ The relationship between the coefficients of \code{p1} (and \code{p2}) and \code{r1} and \code{r2} is determined by a system of linear equations. The system is then solved by applying the pseudo-inverse \code{pinv} for for the left-hand matrix. } \value{ List with components \code{r1} and \code{r2} for the numerator and denominator polynomials, i.e. \code{r1/r2} is the rational approximation sought. } \note{ In general, errors for Pade approximations are smallest when the degrees of numerator and denominator are the same or when the degree of the numerator is one larger than that of the denominator. } \references{ Press, W. H., S. A. Teukolsky, W. T Vetterling, and B. P. Flannery (2007). Numerical Recipes: The Art of Numerical Computing. Third Edition, Cambridge University Press, New York. } \seealso{ \code{\link{taylor}}, \code{ratInterp} } \examples{ ## Exponential function p1 <- c(1/24, 1/6, 1/2, 1.0, 1.0) # Taylor series of exp(x) at x=0 R <- pade(p1); r1 <- R$r1; r2 <- R$r2 f1 <- function(x) polyval(r1, x) / polyval(r2, x) \dontrun{ xs <- seq(-1, 1, length.out=51); ys1 <- exp(xs); ys2 <- f1(xs) plot(xs, ys1, type = "l", col="blue") lines(xs, ys2, col = "red") grid()} } \keyword{ math } pracma/man/dot.Rd0000644000176200001440000000144512042212424013342 0ustar liggesusers\name{dot} \alias{dot} \title{Scalar Product} \description{ 'dot' or 'scalar' product of vectors or pairwise columns of matrices. } \usage{ dot(x, y) } \arguments{ \item{x}{numeric vector or matrix} \item{y}{numeric vector or matrix} } \details{ Returns the 'dot' or 'scalar' product of vectors or columns of matrices. Two vectors must be of same length, two matrices must be of the same size. If \code{x} and \code{y} are column or row vectors, their dot product will be computed as if they were simple vectors. } \value{ A scalar or vector of length the number of columns of \code{x} and \code{y}. } \seealso{ \code{\link{cross}} } \examples{ dot(1:5, 1:5) #=> 55 # Length of space diagonal in 3-dim- cube: sqrt(dot(c(1,1,1), c(1,1,1))) #=> 1.732051 } \keyword{ array } pracma/man/beep.Rd0000644000176200001440000000100712002211134013452 0ustar liggesusers\name{disp,beep} \alias{disp} \alias{beep} \title{ Utility functions (Matlab style) } \description{ Display text or array, or produce beep sound. } \usage{ disp(...) beep() } \arguments{ \item{...}{any R object that can be printed.} } \details{ Display text or array, or produces the computer's default beep sound using `cat' with closing newline. } \value{ beep() returns NULL invisibly, disp() displays with newline. } \examples{ disp("Some text, and numbers:", pi, exp(1)) # beep() } \keyword{ utilities } pracma/man/poly.Rd0000644000176200001440000000136413462656464013566 0ustar liggesusers\name{Poly} \alias{Poly} \title{Define Polynomial by Roots} \description{ Define a polynomial by its roots. } \usage{ Poly(x) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{vector or square matrix, real or complex} } \details{ Computes the characteristic polynomial of an (n x n)-Matrix. If \code{x} is a vector, \code{Poly(x)} is the vector of coefficients of the polynomial whose roots are the elements of \code{x}. } \value{ Vector representing a polynomial. } \note{ In Matlab/Octave this function is called \code{poly()}. } \seealso{ \code{\link{polyval}}, \code{\link{roots}} } \examples{ Poly(c(1, -1, 1i, -1i)) # Solves x^4 -1 = 0 # Wilkinson's example: roots(Poly(1:20)) } \keyword{ math } pracma/man/plotyy.Rd0000644000176200001440000000304412042212424014111 0ustar liggesusers\name{plotyy} \alias{plotyy} \title{ Plotting Two y-Axes } \description{ Line plot with y-axes on both left and right side. } \usage{ plotyy(x1, y1, x2, y2, gridp = TRUE, box.col = "grey", type = "l", lwd = 1, lty = 1, xlab = "x", ylab = "y", main = "", col.y1 = "navy", col.y2 = "maroon", ...) } \arguments{ \item{x1, x2}{x-coordinates for the curves} \item{y1, y2}{the y-values, with ordinates y1 left, y2 right.} \item{gridp}{logical; shall a grid be plotted.} \item{box.col}{color of surrounding box.} \item{type}{type of the curves, line or points (for both data).} \item{lwd}{line width (for both data).} \item{lty}{line type (for both data).} \item{xlab, ylab}{text below and on the left.} \item{main}{main title of the plot.} \item{col.y1, col.y2}{colors to be used for the lines or points.} \item{...}{additional plotting parameters.} } \details{ Plots \code{y1} versus \code{x1} with y-axis labeling on the left and plots \code{y2} versus \code{x2} with y-axis labeling on the right. The x-values should not be too far appart. To exclude certain points, use \code{NA} values. Both curves will be line or point plots, and have the same line type and width. } \value{ Generates a graph, no return values. } \seealso{ \code{plotrix::twoord.plot} } \examples{ \dontrun{ x <- seq(0, 20, by = 0.01) y1 <- 200*exp(-0.05*x)*sin(x) y2 <- 0.8*exp(-0.5*x)*sin(10*x) plotyy(x, y1, x, y2, main = "Two-ordinates Plot") } } \keyword{ graphs } pracma/man/lsqlin.Rd0000644000176200001440000000540112634736623014075 0ustar liggesusers\name{lsqlin} \alias{lsqlin} \title{ Linear Least-Squares Fitting } \description{ Solves linearly constrained linear least-squares problems. } \usage{ lsqlin(A, b, C, d, tol = 1e-13) } \arguments{ \item{A}{\code{nxm}-matrix defining the least-squares problem.} \item{b}{vector or colum matrix with \code{n} rows; when it has more than one column it describes several least-squares problems.} \item{C}{\code{pxm}-matrix for the constraint system.} \item{d}{vector or \code{px1}-matrix, right hand side for the constraints.} \item{tol}{tolerance to be passed to \code{pinv}.} } \details{ \code{lsqlin(A, b, C, d)} minimizes \code{||A*x - b||} (i.e., in the least-squares sense) subject to \code{C*x = d}. } \value{ Returns a least-squares solution as column vector, or a matrix of solutions in the columns if \code{b} is a matrix with several columns. } \note{ The Matlab function \code{lsqlin} solves a more general problem, allowing additional linear inequalities and bound constraints. In \code{pracma} this task is solved applying function \code{lsqlincon}. } \author{ HwB email: } \references{ Trefethen, L. N., and D. Bau III. (1997). Numerical Linear Algebra. SIAM, Society for Industrial and Applied Mathematics, Philadelphia. } \seealso{ \code{\link{nullspace}}, \code{\link{pinv}}, \code{\link{lsqlincon}} } \examples{ A <- matrix(c( 0.8147, 0.1576, 0.6557, 0.9058, 0.9706, 0.0357, 0.1270, 0.9572, 0.8491, 0.9134, 0.4854, 0.9340, 0.6324, 0.8003, 0.6787, 0.0975, 0.1419, 0.7577, 0.2785, 0.4218, 0.7431, 0.5469, 0.9157, 0.3922, 0.9575, 0.7922, 0.6555, 0.9649, 0.9595, 0.1712), 10, 3, byrow = TRUE) b <- matrix(c( 0.7060, 0.4387, 0.0318, 0.3816, 0.2769, 0.7655, 0.0462, 0.7952, 0.0971, 0.1869, 0.8235, 0.4898, 0.6948, 0.4456, 0.3171, 0.6463, 0.9502, 0.7094, 0.0344, 0.7547), 10, 2, byrow = TRUE) C <- matrix(c( 1.0000, 1.0000, 1.0000, 1.0000, -1.0000, 0.5000), 2, 3, byrow = TRUE) d <- as.matrix(c(1, 0.5)) # With a full rank constraint system (L <- lsqlin(A, b, C, d)) # 0.10326838 0.3740381 # 0.03442279 0.1246794 # 0.86230882 0.5012825 C \%*\% L # 1.0 1.0 # 0.5 0.5 \dontrun{ # With a rank deficient constraint system C <- str2num('[1 1 1;1 1 1]') d <- str2num('[1;1]') (L <- lsqlin(A, b[, 1], C, d)) # 0.2583340 # -0.1464215 # 0.8880875 C \%*\% L # 1 1 as column vector # Where both A and C are rank deficient A2 <- repmat(A[, 1:2], 1, 2) C <- ones(2, 4) # d as above (L <- lsqlin(A2, b[, 2], C, d)) # 0.2244121 # 0.2755879 # 0.2244121 # 0.2755879 C \%*\% L # 1 1 as column vector} } \keyword{ fitting } pracma/man/semilog.Rd0000644000176200001440000000142112064403271014213 0ustar liggesusers\name{semilogx,semilogy} \alias{semilogx} \alias{semilogy} \alias{loglog} \title{ Semi-logarithmic Plots (Matlab Style) } \description{ Generates semi- and double-logarithmic plots. } \usage{ semilogx(x, y, ...) semilogy(x, y, ...) loglog(x, y, ...) } \arguments{ \item{x, y}{x-, y-coordinates.} \item{...}{additional graphical parameters passed to the plot function.} } \details{ Plots data in logarithmic scales for the x-axis or y-axis, or uses logarithmic scales in both axes, and adds grid lines. } \value{ Generates a plot, returns nothing. } \note{ Matlab's logarithmic plots find a more appropriate grid. } \seealso{ \code{\link{plot}} with \code{log= } option. } \examples{ \dontrun{ x <- logspace(-1, 2) loglog(x, exp(x), type = 'b')} } \keyword{ graphs } pracma/man/norm.Rd0000644000176200001440000000256012030661542013534 0ustar liggesusers\name{Norm} \alias{Norm} \title{ Vector Norm } \description{ The \code{Norm} function calculates several different types of vector norms for \code{x}, depending on the argument \code{p}. } \usage{ Norm(x, p = 2) } \arguments{ \item{x}{Numeric vector; matrices not allowed.} \item{p}{Numeric scalar or Inf, -Inf; default is 2} } \details{ \code{Norm} returns a scalar that gives some measure of the magnitude of the elements of \code{x}. It is called the \eqn{p}-norm for values \eqn{-Inf \le p \le Inf}, defining Hilbert spaces on \eqn{R^n}. \code{Norm(x)} is the Euclidean length of a vecor \code{x}; same as \code{Norm(x, 2)}.\cr \code{Norm(x, p)} for finite p is defined as \code{sum(abs(A)^p)^(1/p)}.\cr \code{Norm(x, Inf)} returns \code{max(abs(x))}, while \code{Norm(x, -Inf)} returns \code{min(abs(x))}. } \value{ Numeric scalar (or \code{Inf}), or \code{NA} if an element of \code{x} is \code{NA}. } \note{ In Matlab/Octave this is called \code{norm}; R's \code{norm} function \code{norm(x, "F")} (`Frobenius Norm') is the same as \code{Norm(x)}. } \seealso{ \code{\link{norm}} of a matrix } \examples{ Norm(c(3, 4)) #=> 5 Pythagoras triple Norm(c(1, 1, 1), p=2) # sqrt(3) Norm(1:10, p = 1) # sum(1:10) Norm(1:10, p = 0) # Inf Norm(1:10, p = Inf) # max(1:10) Norm(1:10, p = -Inf) # min(1:10) } \keyword{ array } pracma/man/trigonometric.Rd0000644000176200001440000000174312057642712015457 0ustar liggesusers\name{cot,csc,sec, etc.} \alias{cot} \alias{csc} \alias{sec} \alias{acot} \alias{acsc} \alias{asec} \title{ More Trigonometric Functions } \description{ More trigonometric functions not available in R. } \usage{ cot(z) csc(z) sec(z) acot(z) acsc(z) asec(z) } \arguments{ \item{z}{numeric or complex scalar or vector.} } \details{ The usual trigonometric cotangens, cosecans, and secans functions and their inverses, computed through the other well known -- in R -- sine, cosine, and tangens functions. } \value{ Result vector of numeric or complex values. } \note{ These function names are available in Matlab, that is the reason they have been added to the `pracma' package. } \seealso{ Trigonometric and hyperbolic functions in R. } \examples{ cot(1+1i) # 0.2176 - 0.8680i csc(1+1i) # 0.6215 - 0.3039i sec(1+1i) # 0.4983 + 0.5911i acot(1+1i) # 0.5536 - 0.4024i acsc(1+1i) # 0.4523 - 0.5306i asec(1+1i) # 1.1185 + 0.5306i } \keyword{ math } pracma/man/gaussHermite.Rd0000644000176200001440000000322612763544663015242 0ustar liggesusers\name{gaussHermite} \alias{gaussHermite} \title{ Gauss-Hermite Quadrature Formula } \description{ Nodes and weights for the n-point Gauss-Hermite quadrature formula. } \usage{ gaussHermite(n) } \arguments{ \item{n}{Number of nodes in the interval \code{]-Inf, Inf[}.} } \details{ Gauss-Hermite quadrature is used for integrating functions of the form \deqn{\int_{-\infty}^{\infty} f(x) e^{-x^2} dx} over the infinite interval \eqn{]-\infty, \infty[}. \code{x} and \code{w} are obtained from a tridiagonal eigenvalue problem. The value of such an integral is then \code{sum(w*f(x))}. } \value{ List with components \code{x}, the nodes or points in\code{]-Inf, Inf[}, and \code{w}, the weights applied at these nodes. } \references{ Gautschi, W. (2004). Orthogonal Polynomials: Computation and Approximation. Oxford University Press. Trefethen, L. N. (2000). Spectral Methods in Matlab. SIAM, Society for Industrial and Applied Mathematics. } \note{ The basic quadrature rules are well known and can, e. g., be found in Gautschi (2004) --- and explicit Matlab realizations in Trefethen (2000). These procedures have also been implemented in Matlab by Geert Van Damme, see his entries at MatlabCentral since 2010. } \seealso{ \code{\link{gaussLegendre}}, \code{\link{gaussLaguerre}} } \examples{ cc <- gaussHermite(17) # Integrate exp(-x^2) from -Inf to Inf sum(cc$w) #=> 1.77245385090552 == sqrt(pi) # Integrate x^2 exp(-x^2) sum(cc$w * cc$x^2) #=> 0.88622692545276 == sqrt(pi) /2 # Integrate cos(x) * exp(-x^2) sum(cc$w * cos(cc$x)) #=> 1.38038844704314 == sqrt(pi)/exp(1)^0.25 } \keyword{ math } pracma/man/ifft.Rd0000644000176200001440000000346212074770002013513 0ustar liggesusers\name{ifft} \alias{ifft} \alias{ifftshift} \alias{fftshift} \title{ Inverse Fast Fourier Transformation } \description{ Performs the inverse Fast Fourier Transform. } \usage{ ifft(x) ifftshift(x) fftshift(x) } \arguments{ \item{x}{a real or complex vector} } \details{ \code{ifft} returns the value of the normalized discrete, univariate, inverse Fast Fourier Transform of the values in \code{x}. \code{ifftshift} and \code{fftshift} shift the zero-component to the center of the spectrum, that is swap the left and right half of \code{x}. } \value{ Real or complex vector of the same length. } \note{ Almost an alias for R's \code{fft(x, inverse=TRUE)}, but dividing by \code{length(x)}. } \seealso{ \code{\link{fft}} } \examples{ x <- c(1, 2, 3, 4) (y <- fft(x)) ifft(x) ifft(y) ## Compute the derivative: F(df/dt) = (1i*k) * F(f) # hyperbolic secans f <- sech df <- function(x) -sech(x) * tanh(x) d2f <- function(x) sech(x) - 2*sech(x)^3 L <- 20 # domain [-L/2, L/2] N <- 128 # number of Fourier nodes x <- linspace(-L/2, L/2, N+1) # domain discretization x <- x[1:N] # because of periodicity dx <- x[2] - x[1] # finite difference u <- sech(x) # hyperbolic secans u1d <- df(x); u2d <- d2f(x) # first and second derivative ut <- fft(u) # discrete Fourier transform k <- (2*pi/L)*fftshift((-N/2):(N/2-1)) # shifted frequencies u1 <- Re(ifft((1i*k) * ut)) # inverse transform u2 <- Re(ifft(-k^2 * ut)) # first and second derivative \dontrun{ plot(x, u1d, type = "l", col = "blue") points(x, u1) grid() figure() plot(x, u2d, type = "l", col = "darkred") points(x, u2) grid()} } \keyword{ array } pracma/man/eps.Rd0000644000176200001440000000133012201120010013316 0ustar liggesusers\name{eps} \alias{eps} \title{ Floating Point Relative Accuracy } \description{ Distance from 1.0 to the next largest double-precision number. } \usage{ eps(x = 1.0) } \arguments{ \item{x}{scalar or numerical vector or matrix.} } \details{ \code{d=eps(x)} is the positive distance from \code{abs(x)} to the next larger floating point number in double precision. If \code{x} is an array, \code{eps(x)} will return \code{eps(max(abs(x)))}. } \value{ Returns a scalar. } \examples{ for (i in -5:5) cat(eps(10^i), "\n") # 1.694066e-21 # 1.355253e-20 # 2.168404e-19 # 1.734723e-18 # 1.387779e-17 # 2.220446e-16 # 1.776357e-15 # 1.421085e-14 # 1.136868e-13 # 1.818989e-12 # 1.455192e-11 } \keyword{ arith } pracma/man/itersolve.Rd0000644000176200001440000000306412105737273014605 0ustar liggesusers\name{itersolve} \alias{itersolve} \title{ Iterative Methods } \description{ Iterative solutions of systems of linear equations. } \usage{ itersolve(A, b, x0 = NULL, nmax = 1000, tol = .Machine$double.eps^(0.5), method = c("Gauss-Seidel", "Jacobi", "Richardson")) } \arguments{ \item{A}{numerical matrix, square and non-singular.} \item{b}{numerical vector or column vector.} \item{x0}{starting solution for iteration; defaults to null vector.} \item{nmax}{maximum number of iterations.} \item{tol}{relative tolerance.} \item{method}{iterative method, Gauss-Seidel, Jacobi, or Richardson.} } \details{ Iterative methods are based on splitting the matrix \code{A=(P-A)-A} with a so-called `preconditioner' matrix P. The methods differ in how to choose this preconditioner. } \value{ Returns a list with components \code{x} the solution, \code{iter} the number of iterations, and \code{method} the name of the method applied. } \references{ Quarteroni, A., and F. Saleri (2006). Scientific Computing with MATLAB and Octave. Springer-Verlag, Berlin Heidelberg. } \note{ Richardson's method allows to specify a `preconditioner'; this has not been implemented yet. } \seealso{ \code{\link{qrSolve}} } \examples{ N <- 10 A <- Diag(rep(3,N)) + Diag(rep(-2, N-1), k=-1) + Diag(rep(-1, N-1), k=1) b <- A \%*\% rep(1, N) x0 <- rep(0, N) itersolve(A, b, tol = 1e-8, method = "Gauss-Seidel") # [1] 1 1 1 1 1 1 1 1 1 1 # [1] 87 itersolve(A, b, x0 = 1:10, tol = 1e-8, method = "Jacobi") # [1] 1 1 1 1 1 1 1 1 1 1 # [1] 177 } \keyword{ array } pracma/man/rref.Rd0000644000176200001440000000313014000041732013501 0ustar liggesusers\name{rref} \alias{rref} \title{ Reduced Row Echelon Form } \description{ Produces the reduced row echelon form of \code{A} using Gauss Jordan elimination with partial pivoting. } \usage{ rref(A) } \arguments{ \item{A}{numeric matrix.} } \details{ A matrix of ``row-reduced echelon form" has the following characteristics: 1. All zero rows are at the bottom of the matrix 2. The leading entry of each nonzero row after the first occurs to the right of the leading entry of the previous row. 3. The leading entry in any nonzero row is 1. 4. All entries in the column above and below a leading 1 are zero. Roundoff errors may cause this algorithm to compute a different value for the rank than \code{rank}, \code{orth} or \code{null}. } \value{ A matrix the same size as \code{m}. } \note{ This serves demonstration purposes only; don't use for large matrices. } \references{ Weisstein, Eric W. ``Echelon Form." From MathWorld -- A Wolfram Web Resource.\cr \url{https://mathworld.wolfram.com/EchelonForm.html} } \seealso{ \code{\link{qr.solve}} } \examples{ A <- matrix(c(1, 2, 3, 1, 3, 2, 3, 2, 1), 3, 3, byrow = TRUE) rref(A) # [,1] [,2] [,3] # [1,] 1 0 0 # [2,] 0 1 0 # [3,] 0 0 1 A <- matrix(data=c(1, 2, 3, 2, 5, 9, 5, 7, 8,20, 100, 200), nrow=3, ncol=4, byrow=FALSE) rref(A) # 1 0 0 120 # 0 1 0 0 # 0 0 1 -20 # Use rref on a rank-deficient magic square: A = magic(4) R = rref(A) zapsmall(R) # 1 0 0 1 # 0 1 0 3 # 0 0 1 -3 # 0 0 0 0 } \keyword{ math } pracma/man/pascal.Rd0000644000176200001440000000064512465405723014037 0ustar liggesusers\name{pascal} \alias{pascal} \title{ Pascal Triangle } \description{ Pascal triangle in matrix format } \usage{ pascal(n, k = 0) } \arguments{ \item{n}{natural number} \item{k}{natural number, \code{k <= n}} } \details{ Pascal triangle with \code{k} variations. } \value{ matrix representing the Pascal triangle } \seealso{ \code{nchoosek} } \examples{ pascal(5) pascal(5, 1) pascal(5, 2) } \keyword{ specmat } pracma/man/strcmp.Rd0000644000176200001440000000132311540452742014072 0ustar liggesusers\name{strcmp} \alias{strcmp} \alias{strcmpi} \title{String Comparison} \description{ Compare two strings or character vectors for equality. } \usage{ strcmp(s1, s2) strcmpi(s1, s2) } \arguments{ \item{s1, s2}{character strings or vectors} } \details{ For \code{strcmp} comparisons are case-sensitive, while for \code{strcmpi} the are case-insensitive. Leading and trailing blanks do count. } \value{ logical, i.e. \code{TRUE} if \code{s1} and \code{s2} have the same length as character vectors and all elements are equal as character strings, else \code{FALSE}. } \seealso{ \code{\link{strcat}} } \examples{ strcmp(c("yes", "no"), c("yes", "no")) strcmpi(c("yes", "no"), c("Yes", "No")) } \keyword{ string } pracma/man/sigmoid.Rd0000644000176200001440000000222312031245633014210 0ustar liggesusers\name{sigmoid} \alias{sigmoid} \alias{logit} \title{ Sigmoid Function } \description{ Sigmoid function (aka sigmoidal curve or logistic function). } \usage{ sigmoid(x, a = 1, b = 0) logit(x, a = 1, b = 0) } \arguments{ \item{x}{numeric vector.} \item{a, b}{parameters.} } \details{ The \code{sigmoidal} function with parameters \code{a,b} is the function \deqn{y = 1/(1 + e^{-a (x-b)})} The \code{sigmoid} function is also the solution of the ordinary differentialequation \deqn{y' = y (1-y)} with \eqn{y(0) = 1/2} and has an indefinite integral \eqn{\ln(1 + e^x)}. The \code{logit} function is the inverse of the sigmoid function and is (therefore) omly defined between 0 and 1. Its definition is \deqn{y = b + 1/a log(x/(1-x))} } \value{ Numeric/complex scalar or vector. } \examples{ x <- seq(-6, 6, length.out = 101) y1 <- sigmoid(x) y2 <- sigmoid(x, a = 2) \dontrun{ plot(x, y1, type = "l", col = "darkblue", xlab = "", ylab = "", main = "Sigmoid Function(s)") lines(x, y2, col = "darkgreen") grid()} # The slope in 0 (in x = b) is a/4 # sigmf with slope 1 and range [-1, 1]. sigmf <- function(x) 2 * sigmoid(x, a = 2) - 1 } pracma/man/mean.Rd0000644000176200001440000000321312073574411013502 0ustar liggesusers\name{geomean, harmmean} \alias{geomean} \alias{harmmean} \alias{trimmean} \title{ Geometric and Harmonic Mean (Matlab Style) } \description{ Geometric and harmonic mean along a dimension of a vector, matrix, or array.\cr \code{trimmean} is almost the same as \code{mean} in R. } \usage{ geomean(x, dim = 1) harmmean(x, dim = 1) trimmean(x, percent = 0) } \arguments{ \item{x}{numeric vector, matrix, or array.} \item{dim}{dimension along which to take the mean; \code{dim=1} means along columns, \code{dim=2} along rows, the result will still be a row vector, not a column vector as in Matlab.} \item{percent}{percentage, between 0 and 100, of trimmed values.} } \details{ \code{trimmean} does not call \code{mean} with the \code{trim} option, but rather calculates \code{k<-round(n*percent/100/2)} and leaves out \code{k} values at the beginning and end of the sorted \code{x} vector (or row or column of a matrix). } \value{ Returns a scalar or vector (or array) of geometric or harmonic means: For \code{dim=1} the mean of columns, \code{dim=2} the mean of rows, etc. } \note{ To have an exact analogue of \code{mean(x)} in Matlab, apply \code{trimmean(x)}. } \seealso{ \code{\link{mean}} } \examples{ A <- matrix(1:12, 3, 4) geomean(A, dim = 1) ## [1] 1.817121 4.932424 7.958114 10.969613 harmmean(A, dim = 2) ## [1] 2.679426 4.367246 5.760000 x <- c(-0.98, -0.90, -0.68, -0.61, -0.61, -0.38, -0.37, -0.32, -0.20, -0.16, 0.00, 0.05, 0.12, 0.30, 0.44, 0.77, 1.37, 1.64, 1.72, 2.80) trimmean(x); trimmean(x, 20) # 0.2 0.085 mean(x); mean(x, 0.10) # 0.2 0.085 } \keyword{ stat } pracma/man/grad.Rd0000644000176200001440000000213512101433324013466 0ustar liggesusers\name{grad} \alias{grad} \title{ Numerical Gradient } \description{ Numerical function gradient. } \usage{ grad(f, x0, heps = .Machine$double.eps^(1/3), ...) } \arguments{ \item{f}{function of several variables.} \item{x0}{point where the gradient is to build.} \item{heps}{step size.} \item{...}{more variables to be passed to function \code{f}.} } \details{ Computes the gradient \deqn{(\frac{\partial f}{\partial x_1}, \ldots, \frac{\partial f}{\partial x_n})} numerically using the ``central difference formula''. } \value{ Vector of the same length as \code{x0}. } \references{ Mathews, J. H., and K. D. Fink (1999). Numerical Methods Using Matlab. Third Edition, Prentice Hall. } \seealso{ \code{\link{fderiv}} } \examples{ f <- function(u) { x <- u[1]; y <- u[2]; z <- u[3] return(x^3 + y^2 + z^2 +12*x*y + 2*z) } x0 <- c(1,1,1) grad(f, x0) # 15 14 4 # direction of steepest descent sum(grad(f, x0) * c(1, -1, 0)) # 1 , directional derivative f <- function(x) x[1]^2 + x[2]^2 grad(f, c(0,0)) # 0 0 , i.e. a local optimum } \keyword{ math } pracma/man/simpson2d.Rd0000644000176200001440000000246612042212424014476 0ustar liggesusers\name{simpson2d} \alias{simpson2d} \title{ Double Simpson Integration } \description{ Numerically evaluate double integral by 2-dimensional Simpson method. } \usage{ simpson2d(f, xa, xb, ya, yb, nx = 128, ny = 128, ...) } \arguments{ \item{f}{function of two variables, the integrand.} \item{xa, xb}{left and right endpoint for first variable.} \item{ya, yb}{left and right endpoint for second variable.} \item{nx, ny}{number of intervals in x- and y-direction.} \item{\ldots}{additional parameters to be passed to the integrand.} } \details{ The 2D Simpson integrator has weights that are most easily determined by taking the outer product of the vector of weights for the 1D Simpson rule. } \value{ Numerical scalar, the value of the integral. } \note{ Copyright (c) 2008 W. Padden and Ch. Macaskill for Matlab code published under BSD License on MatlabCentral. } \seealso{ \code{\link{dblquad}}, \code{\link{quad2d}} } \examples{ f1 <- function(x, y) x^2 + y^2 simpson2d(f1, -1, 1, -1, 1) # 2.666666667 , i.e. 8/3 . err = 0 f2 <- function(x, y) y*sin(x)+x*cos(y) simpson2d(f2, pi, 2*pi, 0, pi) # -9.869604401 , i.e. -pi^2, err = 2e-8 f3 <- function(x, y) sqrt((1 - (x^2 + y^2)) * (x^2 + y^2 <= 1)) simpson2d(f3, -1, 1, -1, 1) # 2.094393912 , i.e. 2/3*pi , err = 1e-6 } \keyword{ math } pracma/man/mexpfit.Rd0000644000176200001440000000621313575441162014245 0ustar liggesusers\name{mexpfit} \alias{mexpfit} \title{ Multi-exponential Fitting } \description{ Multi-exponential fitting means fitting of data points by a sum of (decaying) exponential functions, with or without a constant term. } \usage{ mexpfit(x, y, p0, w = NULL, const = TRUE, options = list()) } \arguments{ \item{x, y}{x-, y-coordinates of data points to be fitted.} \item{p0}{starting values for the exponentials alone; can be positive or negative, but not zero.} \item{w}{weight vector; not used in this version.} \item{const}{logical; shall an absolute term be included.} \item{options}{list of options for \code{lsqnonlin}, see there.} } \details{ The multi-exponential fitting problem is solved here with with a separable nonlinear least-squares approach. If the following function is to be fitted, \deqn{y = a_0 + a_1 e^{b_1 x} + \ldots + a_n e^{b_n x}} it will be looked at as a nonlinear optimization problem of the coefficients \eqn{b_i} alone. Given the \eqn{b_i}, coefficients \eqn{a_i} are uniquely determined as solution of an (overdetermined) system of linear equations. This approach reduces the dimension of the search space by half and improves numerical stability and accuracy. As a convex problem, the solution is unique and global. To solve the nonlinear part, the function \code{lsqnonlin} that uses the Levenberg-Marquard algorithm will be applied. } \value{ \code{mexpfit} returns a list with the following elements: \itemize{ \item \code{a0}: the absolute term, 0 if \code{const} is false. \item \code{a}: linear coefficients. \item \code{b}: coefficient in the exponential functions. \item \code{ssq}: the sum of squares for the final fitting. \item \code{iter}: number of iterations resp. function calls. \item \code{errmess}: an error or info message. } } \note{ As the Jacobian for this expression is known, a more specialized approch would be possible, without using \code{lsqnonlin}; see the \code{immoptibox} of H. B. Nielsen, Techn. University of Denmark. } \author{ HwB email: } \references{ Madsen, K., and H. B. Nielsen (2010). Introduction to Optimization and Data Fitting. Technical University of Denmark, Intitute of Computer Science and Mathematical Modelling. Nielsen, H. B. (2000). Separable Nonlinear Least Squares. IMM, DTU, Report IMM-REP-2000-01. } \seealso{ \code{\link{lsqsep}}, \code{\link{lsqnonlin}} } \examples{ # Lanczos1 data (artificial data) # f(x) = 0.0951*exp(-x) + 0.8607*exp(-3*x) + 1.5576*exp(-5*x) x <- linspace(0, 1.15, 24) y <- c(2.51340000, 2.04433337, 1.66840444, 1.36641802, 1.12323249, 0.92688972, 0.76793386, 0.63887755, 0.53378353, 0.44793636, 0.37758479, 0.31973932, 0.27201308, 0.23249655, 0.19965895, 0.17227041, 0.14934057, 0.13007002, 0.11381193, 0.10004156, 0.08833209, 0.07833544, 0.06976694, 0.06239313) p0 <- c(-0.3, -5.5, -7.6) mexpfit(x, y, p0, const = FALSE) ## $a0 ## [1] 0 ## $a ## [1] 0.09510431 0.86071171 1.55758398 ## $b ## [1] -1.000022 -3.000028 -5.000009 ## $ssq ## [1] 1.936163e-16 ## $iter ## [1] 26 ## $errmess ## [1] "Stopped by small gradient." } \keyword{ fitting } pracma/man/haversine.Rd0000644000176200001440000000330212765332216014550 0ustar liggesusers\name{haversine} \alias{haversine} \title{ Haversine Formula } \description{ Haversine formula to calculate the arc distance between two points on earth (i.e., along a great circle). } \usage{ haversine(loc1, loc2, R = 6371.0) } \arguments{ \item{loc1, loc2}{Locations on earth; for format see Details.} \item{R}{Average earth radius R = 6371 km, can be changed on input.} } \details{ The Haversine formula is more robust for the calculating the distance as with the spherical cosine formula. The user may want to assume a slightly different earth radius, so this can be provided as input. The location can be input in two different formats, as latitude and longitude in a character string, e.g. for Frankfurt airport as '50 02 00N, 08 34 14E', or as a numerical two-vector in degrees (not radians). Here for latitude 'N' and 'S' stand for North and South, and for longitude 'E' or 'W' stand for East and West. For the degrees format, South and West must be negative. These two formats can be mixed. } \value{ Returns the distance in km. } \references{ Entry 'Great_circle_distance' in Wikipedia. } \author{ Hans W. Borchers } \seealso{ Implementations of the Haversine formula can also be found in other R packages, e.g. 'geoPlot' or 'geosphere'. } \examples{ FRA = '50 02 00N, 08 34 14E' # Frankfurt Airport ORD = '41 58 43N, 87 54 17W' # Chicago O'Hare Interntl. Airport fra <- c(50+2/60, 8+34/60+14/3600) ord <- c(41+58/60+43/3600, -(87+54/60+17/3600)) dis <- haversine(FRA, ORD) # 6971.059 km fprintf('Flight distance Frankfurt-Chicago is \%8.3f km.\n', dis) dis <- haversine(fra, ord) fprintf('Flight distance Frankfurt-Chicago is \%8.3f km.\n', dis) } \keyword{ geom } pracma/man/polyfit.Rd0000644000176200001440000000410012722564044014246 0ustar liggesusers\name{polyfit,polyfix} \alias{polyfit} \alias{polyfix} \title{Fitting by Polynomial} \description{ Polynomial curve fitting } \usage{ polyfit(x, y, n) polyfix(x, y, n, xfix, yfix) } \arguments{ \item{x}{x-coordinates of points} \item{y}{y-coordinates of points} \item{n}{degree of the fitting polynomial} \item{xfix,yfix}{x- and y-coordinates of points to be fixed} } \details{ \code{polyfit} finds the coefficients of a polynomial of degree \code{n} fitting the points given by their \code{x}, \code{y} coordinates in a least-squares sense. In \code{polyfit}, if \code{x}, \code{y} are matrices of the same size, the coordinates are taken elementwise. Complex values are not allowed. \code{polyfix} finds a polynomial that fits the data in a least-squares sense, but also passes exactly through all the points with coordinates \code{xfix} and \code{yfix}. Degree \code{n} should be greater or equal to the number of fixed points, but not too big to avoid `singular matrix' or similar error messages } \value{ vector representing a polynomial. } \note{ Please not that \code{polyfit2} is has been removed since 1.9.3; please use \code{polyfix} instead. } \seealso{ \code{\link{poly}}, \code{\link{polyval}} } \examples{ # Fitting the sine function by a polynomial x <- seq(0, pi, length.out=25) y <- sin(x) p <- polyfit(x, y, 6) \dontrun{ # Plot sin and fitted polynomial plot(x, y, type="b") yf <- polyval(p, x) lines(x, yf, col="red") grid()} \dontrun{ n <- 3 N <- 100 x <- linspace(0, 2*pi, N); y = sin(x) + 0.1*rnorm(N) xfix <- c(0, 2*pi); yfix = c(0, 0) xs <- linspace(0, 2*pi); ys <- sin(xs) plot(xs, ys, type = 'l', col = "gray", main = "Polynom Approximation of Degree 3") grid() points(x, y, pch='o', cex=0.5) points(xfix, yfix, col = "darkred") p0 <- polyfit(x, y, n) lines(xs, polyval(p0, xs), col = "blue") p1 <- polyfix(x, y, n, xfix, yfix) lines(xs, polyval(p1, xs), col = "red") legend(4, 1, c("sin", "polyfit", "polyfix"), col=c("gray", "blue", "red"), lty=c(1,1,1))} } \keyword{ math } pracma/man/sumalt.Rd0000644000176200001440000000361312465177436014106 0ustar liggesusers\name{sumalt} \alias{sumalt} \title{ Alternating Series Acceleration } \description{ Computes the value of an (infinite) alternating sum applying an acceleration method found by Cohen et al. } \usage{ sumalt(f_alt, n) } \arguments{ \item{f_alt}{a funktion of \code{k=0..Inf} that returns element \code{a_k} of the infinite alternating series.} \item{n}{number of elements of the series used for calculating.} } \details{ Computes the sum of an alternating series (whose entries are strictly decreasing), applying the acceleration method developped by H. Cohen, F. Rodriguez Villegas, and Don Zagier. For example, to compute the Leibniz series (see below) to 15 digits exactly, \code{10^15} summands of the series will be needed. This accelleration approach here will only need about 20 of them! } \value{ Returns an approximation of the series value. } \references{ Henri Cohen, F. Rodriguez Villegas, and Don Zagier. Convergence Acceleration of Alternating Series. Experimental Mathematics, Vol. 9 (2000). } \author{ Implemented by Hans W Borchers. } \seealso{ \code{\link{aitken}} } \examples{ # Beispiel: Leibniz-Reihe 1 - 1/3 + 1/5 - 1/7 +- ... a_pi4 <- function(k) (-1)^k / (2*k + 1) sumalt(a_pi4, 20) # 0.7853981633974484 = pi/4 + eps() # Beispiel: Van Wijngaarden transform needs 60 terms n <- 60; N <- 0:n a <- cumsum((-1)^N / (2*N+1)) for (i in 1:n) { a <- (a[1:(n-i+1)] + a[2:(n-i+2)]) / 2 } a - pi/4 # 0.7853981633974483 # Beispiel: 1 - 1/2^2 + 1/3^2 - 1/4^2 +- ... b_alt <- function(k) (-1)^k / (k+1)^2 sumalt(b_alt, 20) # 0.8224670334241133 = pi^2/12 + eps() \dontrun{ # Dirichlet eta() function: eta(s) = 1/1^s - 1/2^s + 1/3^s -+ ... eta_ <- function(s) { eta_alt <- function(k) (-1)^k / (k+1)^s sumalt(eta_alt, 30) } eta_(1) # 0.6931471805599453 = log(2) abs(eta_(1+1i) - eta(1+1i)) # 1.24e-16 } } \keyword{ math } pracma/man/ezplot.Rd0000644000176200001440000000443712763544663014124 0ustar liggesusers\name{ezplot} \alias{ezplot} \alias{fplot} \title{ Easy Function Plot } \description{ Easy function plot w/o the need to define \code{x, y} coordinates. } \usage{ fplot(f, interval, ...) ezplot( f, a, b, n = 101, col = "blue", add = FALSE, lty = 1, lwd = 1, marker = 0, pch = 1, grid = TRUE, gridcol = "gray", fill = FALSE, fillcol = "lightgray", xlab = "x", ylab = "f (x)", main = "Function Plot", ...) } \arguments{ \item{f}{Function to be plotted.} \item{interval}{interval [a, b] to plot the function in} \item{a, b}{Left and right endpoint for the plot.} \item{n}{Number of points to plot.} \item{col}{Color of the function graph.} \item{add}{logical; shall the polt be added to an existing plot.} \item{lty}{line type; default 1.} \item{lwd}{line width; default 1.} \item{marker}{no. of markers to be added to the curve; defailt: none.} \item{pch}{poimt character; default circle.} \item{grid}{Logical; shall a grid be plotted?; default \code{TRUE}.} \item{gridcol}{Color of grid points.} \item{fill}{Logical; shall the area between function and axis be filled?; default: \code{FALSE}.} \item{fillcol}{Color of fill area.} \item{xlab}{Label on the \code{x}-axis.} \item{ylab}{Label on the \code{y}-axis.} \item{main}{Title of the plot} \item{...}{More parameters to be passed to \code{plot}.} } \details{ Calculates the \code{x, y} coordinates of points to be plotted and calls the \code{plot} function. If \code{fill} is \code{TRUE}, also calls the \code{polygon} function with the \code{x, y} coordinates in appropriate order. If the no. of \code{markers} is greater than 2, this number of markers will be added to the curve, with equal distances measured along the curve. } \value{ Plots the function graph and invisibly returns \code{NULL}. } \note{ \code{fplot} is almost an alias for \code{ezplot} as all \code{ez...} will be replaced by MATLAB with function names \code{f...} in 2017. \code{ezplot} should mimick the Matlab function of the same name, has more functionality, misses the possibility to plot several functions. } \seealso{ \code{\link{curve}} } \examples{ \dontrun{ fun <- function(x) x * cos(0.1*exp(x)) * sin(0.1*pi*exp(x)) ezplot(fun, 0, 5, n = 1001, fill = TRUE) } } \keyword{ graphs } pracma/man/find.Rd0000644000176200001440000000070512001565513013477 0ustar liggesusers\name{finds} \alias{finds} \title{find function (Matlab Style)} \description{ Finds indices of nonzero elements. } \usage{ finds(v) } \arguments{ \item{v}{logical or numeric vector or array} } \details{ Finds indices of true or nonzero elements of argument \code{v}; can be used with a logical expression. } \value{ Indices of elements matching the expression \code{x}. } \examples{ finds(-3:3 >= 0) finds(c(0, 1, 0, 2, 3)) } \keyword{logic} pracma/man/polyarea.Rd0000644000176200001440000000725012266311634014403 0ustar liggesusers\name{polyarea} \alias{polyarea} \alias{poly_center} \alias{poly_length} \alias{poly_crossings} \title{Area of a Polygon} \description{ Calculates the area and length of a polygon given by the vertices in the vectors \code{x} and \code{y}. } \usage{ polyarea(x, y) poly_length(x, y) poly_center(x, y) poly_crossings(L1, L2) } \arguments{ \item{x}{x-coordinates of the vertices defining the polygon} \item{y}{y-coordinates of the vertices} \item{L1, L2}{matrices of type \code{2xn} with x- and y-coordinates.} } \details{ \code{polyarea} calculates the area of a polygon defined by the vertices with coordinates \code{x} and \code{y}. Areas to the left of the vertices are positive, those to the right are counted negative. The computation is based on the Gauss polygon area formula. The polygon automatically be closed, that is the last point need not be / should not be the same as the first. If some points of self-intersection of the polygon line are not in the vertex set, the calculation will be inexact. The sum of all areas will be returned, parts that are circulated in the mathematically negative sense will be counted as negative in this sum. If \code{x}, \code{y} are matrices of the same size, the areas of all polygons defined by corresponding columns are computed. \code{poly_center} calculates the center (of mass) of the figure defined by the polygon. Self-intersections should be avoided in this case. The mathematical orientation of the polygon does not have influence on the center coordinates. \code{poly_length} calculates the length of the polygon \code{poly_crossings} calculates the crossing points of two polygons given as matrices with x- and y-coordinates in the first and second row. Can be used for finding the crossing points of parametrizised curves. } \value{ Area or length of the polygon resp. sum of the enclosed areas; or the coordinates of the center of gravity. \code{poly_crossings} returns a matrix with column names \code{x} and \code{y} representing the crossing points. } \seealso{ \code{\link{trapz}}, \code{\link{arclength}} } \examples{ # Zu Chongzhi's calculation of pi (China, about 480 A.D.), # approximating the circle from inside by a regular 12288-polygon(!): phi <- seq(0, 2*pi, len=3*2^12+1) x <- cos(phi) y <- sin(phi) pi_approx <- polyarea(x, y) print(pi_approx, digits=8) #=> 3.1415925 or 355/113 poly_length(x, y) #=> 6.2831852 where 2*pi is 6.2831853 x1 <- x + 0.5; y1 <- y + 0.5 x2 <- rev(x1); y2 <- rev(y1) poly_center(x1, y1) #=> 0.5 0.5 poly_center(x2, y2) #=> 0.5 0.5 # A simple example L1 <- matrix(c(0, 0.5, 1, 1, 2, 0, 1, 1, 0.5, 0), nrow = 2, byrow = TRUE) L2 <- matrix(c(0.5, 0.75, 1.25, 1.25, 0, 0.75, 0.75, 0 ), nrow = 2, byrow = TRUE) P <- poly_crossings(L1, L2) P ## x y ## [1,] 1.00 0.750 ## [2,] 1.25 0.375 \dontrun{ # Crossings of Logarithmic and Archimedian spirals # Logarithmic spiral a <- 1; b <- 0.1 t <- seq(0, 5*pi, length.out = 200) xl <- a*exp(b*t)*cos(t) - 1 yl <- a*exp(b*t)*sin(t) plot(xl, yl, type = "l", lwd = 2, col = "blue", xlim = c(-6, 3), ylim = c(-3, 4), xlab = "", ylab = "", main = "Intersecting Logarithmic and Archimedian spirals") grid() # Archimedian spiral a <- 0; b <- 0.25 r <- a + b*t xa <- r * cos(t) ya <- r*sin(t) lines(xa, ya, type = "l", lwd = 2, col = "red") legend(-6.2, -1.0, c("Logarithmic", "Archimedian"), lwd = 2, col = c("blue", "red"), bg = "whitesmoke") L1 <- rbind(xl, yl) L2 <- rbind(xa, ya) P <- poly_crossings(L1, L2) points(P) } } \keyword{ math } pracma/man/trisolve.Rd0000644000176200001440000000256312060137756014443 0ustar liggesusers\name{trisolve} \alias{trisolve} \title{ Tridiagonal Linear System Solver } \description{ Solves tridiagonal linear systems \code{A*x=rhs} efficiently. } \usage{ trisolve(a, b, d, rhs) } \arguments{ \item{a}{diagonal of the tridiagonal matrix \code{A}.} \item{b, d}{upper and lower secondary diagonal of \code{A}.} \item{rhs}{right hand side of the linear system \code{A*x=rhs}.} } \details{ Solves tridiagonal linear systems \code{A*x=rhs} by applying Givens transformations. By only storing the three diagonals, \code{trisolve} has memory requirements of \code{3*n} instead of \code{n^2} and is faster than the standard \code{solve} function for larger matrices. } \value{ Returns the solution of the tridiagonal linear system as vector. } \note{ Has applications for spline approximations and for solving boundary value problems (ordinary differential equations). } \references{ Gander, W. (1992). Computermathematik. Birkhaeuser Verlag, Basel. } \seealso{ \code{\link{qrSolve}} } \examples{ set.seed(8237) a <- rep(1, 100) e <- runif(99); f <- rnorm(99) x <- rep(seq(0.1, 0.9, by = 0.2), times = 20) A <- diag(100) + Diag(e, 1) + Diag(f, -1) rhs <- A \%*\% x s <- trisolve(a, e, f, rhs) s[1:10] #=> 0.1 0.3 0.5 0.7 0.9 0.1 0.3 0.5 0.7 0.9 s[91:100] #=> 0.1 0.3 0.5 0.7 0.9 0.1 0.3 0.5 0.7 0.9 } \keyword{ array } pracma/man/numel.Rd0000644000176200001440000000053711540452742013710 0ustar liggesusers\name{numel} \alias{numel} \title{Number of Elements} \description{ Number of elements in a vector, matrix, or array. } \usage{ numel(x) } \arguments{ \item{x}{a vector, matrix, array or list} } \value{ the number of elements of \code{a}. } \seealso{ \code{\link{size}} } \examples{ numel(c(1:12)) numel(matrix(1:12, 3, 4)) } \keyword{array} pracma/man/abm3.Rd0000644000176200001440000000267412031327377013417 0ustar liggesusers\name{abm3pc} \alias{abm3pc} \title{ Adams-Bashford-Moulton } \description{ Third-order Adams-Bashford-Moulton predictor-corrector method. } \usage{ abm3pc(f, a, b, y0, n = 50, ...) } \arguments{ \item{f}{function in the differential equation \eqn{y' = f(x, y)}.} \item{a, b}{endpoints of the interval.} \item{y0}{starting values at point \code{a}.} \item{n}{the number of steps from \code{a} to \code{b}.} \item{\ldots}{additional parameters to be passed to the function.} } \details{ Combined Adams-Bashford and Adams-Moulton (or: multi-step) method of third order with corrections according to the predictor-corrector approach. } \value{ List with components \code{x} for grid points between \code{a} and \code{b} and \code{y} a vector \code{y} the same length as \code{x}; additionally an error estimation \code{est.error} that should be looked at with caution. } \references{ Fausett, L. V. (2007). Applied Numerical Analysis Using Matlab. Second edition, Prentice Hall. } \note{ This function serves demonstration purposes only. } \seealso{ \code{\link{rk4}}, \code{\link{ode23}} } \examples{ ## Attempt on a non-stiff equation # y' = y^2 - y^3, y(0) = d, 0 <= t <= 2/d, d = 0.01 f <- function(t, y) y^2 - y^3 d <- 1/250 abm1 <- abm3pc(f, 0, 2/d, d, n = 1/d) abm2 <- abm3pc(f, 0, 2/d, d, n = 2/d) \dontrun{ plot(abm1$x, abm1$y, type = "l", col = "blue") lines(abm2$x, abm2$y, type = "l", col = "red") grid()} } \keyword{ ode } pracma/man/rationalfit.Rd0000644000176200001440000000452011746506572015111 0ustar liggesusers\name{rationalfit} \alias{rationalfit} \title{ Rational Function Approximation } \description{ Fitting a rational function to data points. } \usage{ rationalfit(x, y, d1 = 5, d2 = 5) } \arguments{ \item{x}{numeric vector; points on the x-axis; needs to be sorted; at least three points required.} \item{y}{numeric vector; values of the assumed underlying function; \code{x} and \code{y} must be of the same length.} \item{d1, d2}{maximal degrees of numerator (\code{d1}) and denominator (\code{d1}) of the requested rational function.} } \details{ A rational fit is a rational function of two polynomials \code{p1} and \code{p2} (of user specified degrees \code{d1} and \code{d2}) such that \code{p1(x)/p2(x)} approximates \code{y} in a least squares sense. \code{d1} and \code{d2} must be large enough to get a good fit and usually \code{d1=d2} gives good results } \value{ List with components \code{p1} and \code{p2} for the polynomials in numerator and denominator of the rational function. } \note{ This implementation will later be replaced by a `barycentric rational interpolation'. } \author{ Copyright (c) 2006 by Paul Godfrey for a Matlab version available from the MatlabCentral under BSD license. R re-implementation by Hans W Borchers. } \references{ Press, W. H., S. A. Teukolsky, W. T Vetterling, and B. P. Flannery (2007). Numerical Recipes: The Art of Numerical Computing. Third Edition, Cambridge University Press, New York. } \seealso{ \code{\link{ratinterp}} } \examples{ \dontrun{ x <- linspace(0, 15, 151); y <- sin(x)/x rA <- rationalfit(x, y, 10, 10); p1 <- rA$p1; p2 <- rA$p2 ys <- polyval(p1,x) / polyval(p2,x) plot(x, y, type="l", col="blue", ylim=c(-0.5, 1.0)) points(x, Re(ys), col="red") # max(abs(y-ys), na.rm=TRUE) < 1e-6 grid() # Rational approximation of the Zeta function x <- seq(-5, 5, by = 1/16) y <- zeta(x) rA <- rationalfit(x, y, 10, 10); p1 <- rA$p1; p2 <- rA$p2 ys <- polyval(p1,x) / polyval(p2,x) plot(x, y, type="l", col="blue", ylim=c(-5, 5)) points(x, Re(ys), col="red") grid() # Rational approximation to the Gamma function x <- seq(-5, 5, by = 1/32); y <- gamma(x) rA <- rationalfit(x, y, 10, 10); p1 <- rA$p1; p2 <- rA$p2 ys <- polyval(p1,x) / polyval(p2,x) plot(x, y, type="l", col = "blue") points(x, Re(ys), col="red") grid()} } \keyword{ fitting } pracma/man/l1linreg.Rd0000644000176200001440000000352614000041732014271 0ustar liggesusers\name{L1linreg} \alias{L1linreg} \title{ L1 Linear Regression } \description{ Solve the linear system \code{A x = b} in an Lp sense, that is minimize the term \code{sum |b - A x|^p}. The case \code{p=1} is also called ``least absolute deviation'' (LAD) regression. } \usage{ L1linreg(A, b, p = 1, tol = 1e-07, maxiter = 200) } \arguments{ \item{A}{matrix of independent variables.} \item{b}{independent variables.} \item{p}{the p in L^p norm, \code{p<=1}.} \item{tol}{relative tolerance.} \item{maxiter}{maximum number of iterations.} } \details{ L1/Lp regression is here solved applying the ``iteratively reweighted least square'' (IRLS) method in which each step involves a weighted least squares problem. If an intercept term is required, add a unit column to \code{A}. } \value{ Returns a list with components \code{x} the linear coefficients describing the solution, \code{reltol} the relative tolerance reached, and \code{niter} the number of iterations. } \references{ Dasgupta, M., and S.K. Mishra (2004). Least absolute deviation estimation of linear econometric models: A literature review. MPRA Paper No. 1781. } \note{ In this case of \code{p=1}, the problem would be better approached by use of linear programming methods. } \seealso{ \code{\link{lm}}, \code{\link{lsqnonlin}}, \code{quantreg::rq} } \examples{ m <- 101; n <- 10 # no. of data points, degree of polynomial x <- seq(-1, 1, len=m) y <- runge(x) # Runge's function A <- outer(x, n:0, '^') # Vandermonde matrix b <- y ( sol <- L1linreg(A, b) ) # $x # [1] -21.93242 0.00000 62.91092 0.00000 -67.84854 0.00000 # [7] 34.14400 0.00000 -8.11899 0.00000 0.84533 # # $reltol # [1] 6.712355e-10 # # $niter # [1] 81 # minimum value of polynomial L1 regression sum(abs(polyval(sol$x, x) - y)) # [1] 3.061811 } \keyword{ optimize } pracma/man/gmres.Rd0000644000176200001440000000360212201120010013650 0ustar liggesusers\name{gmres} \alias{gmres} \title{ Generalized Minimal Residual Method } \description{ \code{gmres(A,b)} attempts to solve the system of linear equations \code{A*x=b} for \code{x}. } \usage{ gmres(A, b, x0 = rep(0, length(b)), errtol = 1e-6, kmax = length(b)+1, reorth = 1) } \arguments{ \item{A}{square matrix.} \item{b}{numerical vector or column vector.} \item{x0}{initial iterate.} \item{errtol}{relative residual reduction factor.} \item{kmax}{maximum number of iterations} \item{reorth}{reorthogonalization method, see Details.} } \details{ Iterative method for the numerical solution of a system of linear equations. The method approximates the solution by the vector in a Krylov subspace with minimal residual. The Arnoldi iteration is used to find this vector. Reorthogonalization method:\cr 1 -- Brown/Hindmarsh condition (default)\cr 2 -- Never reorthogonalize (not recommended)\cr 3 -- Always reorthogonalize (not cheap!) } \value{ Returns a list with components \code{x} the solution, \code{error} the vector of residual norms, and \code{niter} the number of iterations. } \references{ C. T. Kelley (1995). Iterative Methods for Linear and Nonlinear Equations. SIAM, Society for Industrial and Applied Mathematics, Philadelphia, USA. } \author{ Based on Matlab code from C. T. Kelley's book, see references. } \seealso{ \code{\link{solve}} } \examples{ A <- matrix(c(0.46, 0.60, 0.74, 0.61, 0.85, 0.56, 0.31, 0.80, 0.94, 0.76, 0.41, 0.19, 0.15, 0.33, 0.06, 0.03, 0.92, 0.15, 0.56, 0.08, 0.09, 0.06, 0.69, 0.42, 0.96), 5, 5) x <- c(0.1, 0.3, 0.5, 0.7, 0.9) b <- A \%*\% x gmres(A, b) # $x # [,1] # [1,] 0.1 # [2,] 0.3 # [3,] 0.5 # [4,] 0.7 # [5,] 0.9 # # $error # [1] 2.37446e+00 1.49173e-01 1.22147e-01 1.39901e-02 1.37817e-02 2.81713e-31 # # $niter # [1] 5 } \keyword{ math } pracma/man/vander.Rd0000644000176200001440000000073512465405723014053 0ustar liggesusers\name{vander} \alias{vander} \title{Vandermonde matrix} \description{ Generate Vandermonde matrix from a numeric vector. } \usage{ vander(x) } \arguments{ \item{x}{Numeric vector} } \details{ Generates the usual Vandermonde matrix from a numeric vector, e.g. applied when fitting a polynomial to given points. Complex values are allowed. } \value{ Vandermonde matrix of dimension n where \code{n = length(x)}. } \examples{ vander(c(1:10)) } \keyword{ specmat } pracma/man/fresnel.Rd0000644000176200001440000000413212465405723014225 0ustar liggesusers\name{fresnelS/C} \alias{fresnelS} \alias{fresnelC} \title{ Fresnel Integrals } \description{ (Normalized) Fresnel integrals S(x) and C(x) } \usage{ fresnelS(x) fresnelC(x) } \arguments{ \item{x}{numeric vector.} } \details{ The \emph{normalized} Fresnel integrals are defined as \deqn{S(x) = \int_0^x \sin(\pi/2 \, t^2) dt} \deqn{C(x) = \int_0^x \cos(\pi/2 \, t^2) dt} This program computes the Fresnel integrals S(x) and C(x) using Fortran code by Zhang and Jin. The accuracy is almost up to Machine precision. The functions are not (yet) truly vectorized, but use a call to `apply'. The underlying function \code{.fresnel} (not exported) computes single values of \code{S(x)} and \code{C(x)} at the same time. } \value{ Numeric vector of function values. } \references{ Zhang, S., and J. Jin (1996). Computation of Special Functions. Wiley-Interscience. } \note{ Copyright (c) 1996 Zhang and Jin for the Fortran routines, converted to Matlab using the open source project `f2matlab' by Ben Barrowes, posted to MatlabCentral in 2004, and then translated to R by Hans W. Borchers. } \seealso{ \code{\link{gaussLegendre}} } \examples{ ## Compute Fresnel integrals through Gauss-Legendre quadrature f1 <- function(t) sin(0.5 * pi * t^2) f2 <- function(t) cos(0.5 * pi * t^2) for (x in seq(0.5, 2.5, by = 0.5)) { cgl <- gaussLegendre(51, 0, x) fs <- sum(cgl$w * f1(cgl$x)) fc <- sum(cgl$w * f2(cgl$x)) cat(formatC(c(x, fresnelS(x), fs, fresnelC(x), fc), digits = 8, width = 12, flag = " ----"), "\n") } \dontrun{ xs <- seq(0, 7.5, by = 0.025) ys <- fresnelS(xs) yc <- fresnelC(xs) ## Function plot of the Fresnel integrals plot(xs, ys, type = "l", col = "darkgreen", xlim = c(0, 8), ylim = c(0, 1), xlab = "", ylab = "", main = "Fresnel Integrals") lines(xs, yc, col = "blue") legend(6.25, 0.95, c("S(x)", "C(x)"), col = c("darkgreen", "blue"), lty = 1) grid() ## The Cornu (or Euler) spiral plot(c(-1, 1), c(-1, 1), type = "n", xlab = "", ylab = "", main = "Cornu Spiral") lines(ys, yc, col = "red") lines(-ys, -yc, col = "red") grid()} } \keyword{ specfun } pracma/man/trigPoly.Rd0000644000176200001440000000263611617020015014370 0ustar liggesusers\name{trigPoly} \alias{trigPoly} \title{ Trigonometric Polynomial } \description{ Computes the trigonometric coefficients. } \usage{ trigPoly(x, m) } \arguments{ \item{x}{data from \code{t=0} to \code{t=2*(n-1)*pi/n}.} \item{m}{degree of trigonometric regression.} } \details{ Compute the coefficients of the trigonometric series of degree \code{m}, \deqn{a_0 + \sum_k(a_k \cos(k t) + b_k \sin(k t))} by applying orthogonality relations. } \value{ Coefficients as a list with components \code{a0}, \code{a}, and \code{b}. } \references{ Fausett, L. V. (2007). Applied Numerical Analysis Using Matlab. Second edition, Prentice Hall. } \note{ For irregular spaced data or data not covering the whole period, use standard regression techniques, see examples. } \seealso{ \code{\link{trigApprox}} } \examples{ # Data available only from 0 to pi/2 t <- seq(0, pi, len=7) x <- 0.5 + 0.25*sin(t) + 1/3*cos(t) - 1/3*sin(2*t) - 0.25*cos(2*t) # use standard regression techniques A <- cbind(1, cos(t), sin(t), cos(2*t), sin(2*t)) ab <- qr.solve(A, x) ab # [1] 0.5000000 0.3333333 0.2500000 -0.2500000 -0.3333333 ts <- seq(0, 2*pi, length.out = 100) xs <- ab[1] + ab[2]*cos(ts) + ab[3]*sin(ts) + ab[4]*cos(2*ts) +ab[5]*sin(2*ts) \dontrun{ # plot to make sure plot(t, x, col = "red", xlim=c(0, 2*pi), ylim=c(-2,2), main = "Trigonometric Regression") lines(ts, xs, col="blue") grid()} } \keyword{ math } pracma/man/kron.Rd0000644000176200001440000000132611540452742013536 0ustar liggesusers\name{kron} \alias{kron} \title{Kronecker product (Matlab Style)} \description{ Kronecker tensor product of two matrices. } \usage{ kron(a, b) } \arguments{ \item{a}{real or complex matrix} \item{b}{real or complex matrix} } \details{ The Kronecker product is a large matrix formed by all products between the elements of \code{a} and those of \code{b}. The first left block is a11*b, etc. } \value{ an \code{(n*p x m*q}-matrix, if \code{a} is \code{(n x m} and \code{b} is \code{(p x q)}. } \note{ \code{kron()} is an alias for the R function \code{kronecker()}, which can also be executed with the binary operator `\%x\%'. } \examples{ a <- diag(1, 2, 2) b <- matrix(1:4, 2, 2) kron(a, b) kron(b, a) } \keyword{ array } pracma/man/eig.Rd0000644000176200001440000000111312042212424013310 0ustar liggesusers\name{eig} \alias{eig} \title{Eigenvalue Function (Matlab Style)} \description{ Eigenvalues of a matrix } \usage{ eig(a) } \arguments{ \item{a}{real or complex square matrix} } \details{ Computes the eigenvalues of a square matrix of real or complex numbers, using the R routine \code{eigen} without computing the eigenvectors. } \value{ Vector of eigenvalues } \seealso{ \code{\link{compan}} } \examples{ eig(matrix(c(1,-1,-1,1), 2, 2)) #=> 2 0 eig(matrix(c(1,1,-1,1), 2, 2)) # complex values eig(matrix(c(0,1i,-1i,0), 2, 2)) # real values } \keyword{ array } pracma/man/titanium.Rd0000644000176200001440000000132611763611614014421 0ustar liggesusers\name{titanium} \alias{titanium} \docType{data} \title{ Titanium Test Data } \description{ The Titanium data set describes measurements of a certain property of titanium as a function of temperature. } \usage{ data(titanium) } \format{ The format is:\cr Two columns called `x' and `y', the first being the temperature. } \details{ These data have become a standard test for data fitting since they are hard to fit by classical techniques and have a significant amount of noise. } \source{ Boor, C. de, and J. R. Rice (1968). Least squares cubic spline approximation II -- Variable knots, CSD TR 21, Comp.Sci., Purdue Univ. } \examples{ \dontrun{ data(titanium) plot(titanium) grid()} } \keyword{ datasets } pracma/man/gaussLegendre.Rd0000644000176200001440000000336412042212424015346 0ustar liggesusers\name{gaussLegendre} \alias{gaussLegendre} \title{ Gauss-Legendre Quadrature Formula } \description{ Nodes and weights for the n-point Gauss-Legendre quadrature formula. } \usage{ gaussLegendre(n, a, b) } \arguments{ \item{n}{Number of nodes in the interval \code{[a,b]}.} \item{a, b}{lower and upper limit of the integral; must be finite.} } \details{ \code{x} and \code{w} are obtained from a tridiagonal eigenvalue problem. } \value{ List with components \code{x}, the nodes or points in\code{[a,b]}, and \code{w}, the weights applied at these nodes. } \references{ Gautschi, W. (2004). Orthogonal Polynomials: Computation and Approximation. Oxford University Press. Trefethen, L. N. (2000). Spectral Methods in Matlab. SIAM, Society for Industrial and Applied Mathematics. } \note{ Gauss quadrature is not suitable for functions with singularities. } \seealso{ \code{\link{gaussHermite}}, \code{\link{gaussLaguerre}} } \examples{ ## Quadrature with Gauss-Legendre nodes and weights f <- function(x) sin(x+cos(10*exp(x))/3) #\dontrun{ezplot(f, -1, 1, fill = TRUE)} cc <- gaussLegendre(51, -1, 1) Q <- sum(cc$w * f(cc$x)) #=> 0.0325036515865218 , true error: < 1e-15 # If f is not vectorized, do an explicit summation: Q <- 0; x <- cc$x; w <- cc$w for (i in 1:51) Q <- Q + w[i] * f(x[i]) # If f is infinite at b = 1, set b <- b - eps (with, e.g., eps = 1e-15) # Use Gauss-Kronrod approach for error estimation cc <- gaussLegendre(103, -1, 1) abs(Q - sum(cc$w * f(cc$x))) # rel.error < 1e-10 # Use Gauss-Hermite for vector-valued functions f <- function(x) c(sin(pi*x), exp(x), log(1+x)) cc <- gaussLegendre(32, 0, 1) drop(cc$w \%*\% matrix(f(cc$x), ncol = 3)) # c(2/pi, exp(1) - 1, 2*log(2) - 1) # absolute error < 1e-15 } \keyword{ math } pracma/man/fletcherpowell.Rd0000644000176200001440000000414113452637217015610 0ustar liggesusers\name{fletcher_powell} \alias{fletcher_powell} \title{ Fletcher-Powell Conjugate Gradient Minimization } \description{ Conjugate Gradient (CG) minimization through the Davidon-Fletcher-Powell approach for function minimization. The Davidon-Fletcher-Powell (DFP) and the Broyden-Fletcher-Goldfarb-Shanno (BFGS) methods are the first quasi-Newton minimization methods developed. These methods differ only in some details; in general, the BFGS approach is more robust. } \usage{ fletcher_powell(x0, f, g = NULL, maxiter = 1000, tol = .Machine$double.eps^(2/3)) } \arguments{ \item{x0}{start value.} \item{f}{function to be minimized.} \item{g}{gradient function of \code{f}; if \code{NULL}, a numerical gradient will be calculated.} \item{maxiter}{max. number of iterations.} \item{tol}{relative tolerance, to be used as stopping rule.} } \details{ The starting point is Newton's method in the multivariate case, when the estimate of the minimum is updated by the following equation \deqn{x_{new} = x - H^{-1}(x) grad(g)(x)} where \eqn{H} is the Hessian and \eqn{grad} the gradient. The basic idea is to generate a sequence of good approximations to the inverse Hessian matrix, in such a way that the approximations are again positive definite. } \value{ List with following components: \item{xmin}{minimum solution found.} \item{fmin}{value of \code{f} at minimum.} \item{niter}{number of iterations performed.} } \references{ J. F. Bonnans, J. C. Gilbert, C. Lemarechal, and C. A. Sagastizabal. Numerical Optimization: Theoretical and Practical Aspects. Second Edition, Springer-Verlag, Berlin Heidelberg, 2006. } \note{ Used some Matlab code as described in the book ``Applied Numerical Analysis Using Matlab'' by L. V.Fausett. } \seealso{ \code{\link{steep_descent}} } \examples{ ## Rosenbrock function rosenbrock <- function(x) { n <- length(x) x1 <- x[2:n] x2 <- x[1:(n-1)] sum(100*(x1-x2^2)^2 + (1-x2)^2) } fletcher_powell(c(0, 0), rosenbrock) # $xmin # [1] 1 1 # $fmin # [1] 1.774148e-27 # $niter # [1] 14 } \keyword{ optimize } pracma/man/poly2str.Rd0000644000176200001440000000125311566702053014363 0ustar liggesusers\name{poly2str} \alias{poly2str} \title{ Print Polynomial } \description{ Print polynomial as a character string. } \usage{ poly2str(p, svar = "x", smul = "*", d = options("digits")$digits) } \arguments{ \item{p}{numeric vector representing a polynomial} \item{svar}{character representing the unknown, default \code{x}.} \item{smul}{multiplication symbol, default \code{*}.} \item{d}{significant digits, default \code{options("digits")}.} } \details{ Simple string manipulation. } \value{ Returns the usual string representing a polynomial in mathematics. } \examples{ poly2str(c(0)) poly2str(c(1, -1, 1, -1, 1)) poly2str(c(0, 1e-6, 1e6), d = 2) } \keyword{ array } pracma/man/sorting.Rd0000644000176200001440000000640211552641253014252 0ustar liggesusers\name{sorting} \alias{bubbleSort} \alias{insertionSort} \alias{selectionSort} \alias{shellSort} \alias{heapSort} \alias{mergeSort} \alias{mergeOrdered} \alias{quickSort} \alias{quickSortx} \alias{is.sorted} \alias{testSort} \title{Sorting Routines} \description{ R implementations of several sorting routines. These implementations are meant for demonstration and lecturing purposes. } \usage{ is.sorted(a) testSort(n = 1000) bubbleSort(a) insertionSort(a) selectionSort(a) shellSort(a, f = 2.3) heapSort(a) mergeSort(a, m = 10) mergeOrdered(a, b) quickSort(a, m = 3) quickSortx(a, m = 25) } \arguments{ \item{a, b}{Numeric vectors to be sorted or merged.} \item{f}{Retracting factor for \code{shellSort}.} \item{m}{Size of subsets that are sorted by \code{insertionSort} when the sorting procedure is called recursively.} \item{n}{Only in \code{testSort}: the length of a vector of random numbers to be sorted.} } \details{ \code{bubbleSort(a)} is the well-known ``bubble sort'' routine; it is forbiddingly slow. \code{insertionSort(a)} sorts the array one entry at a time; it is slow, but quite efficient for small data sets. \code{selectionSort(a)} is an in-place sorting routine that is inefficient, but noted for its simplicity. \code{shellSort(a, f = 2.3)} exploits the fact that insertion sort works efficiently on input that is already almost sorted. It reduces the gaps by the factor \code{f}; \code{f=2.3} is said to be a reasonable choice. \code{heapSort(a)} is not yet implemented. \code{mergeSort(a, m = 10)} works recursively, merging already sorted parts with \code{mergeOrdered}. \code{m} should be between\code{3} and 1/1000 of the size of \code{a}. \code{mergeOrdered(a, b)} works only correctly if \code{a} and \code{a} are already sorted. \code{quickSort(a, m = 3)} realizes the celebrated ``quicksort algorithm'' and is the fastest of all implementations here. To avoid too deeply nested recursion with R, \code{insertionSort} is called when the size of a subset is smaller than \code{m}. Values between \code{3..30} seem reasonable and smaller values are better, with the risk of running into a too deeply nested recursion. \code{quickSort(a, m = 25)} is an extended version where the split is calculated more carefully, but in general this approach takes too much time. Values for \code{m} are \code{20..40} with \code{m=25} favoured. \code{testSort(n = 1000)} is a test routine, e.g. for testing your computer power. On an iMac, \code{quickSort} will sort an array of size 1,000,000 in less than 15 secs. } \value{ All routines return the vector sorted. \code{is.sorted} indicates logically whether the vector is sorted. } \references{ Knuth, D. E. (1973). The Art of Computer Programming, Volume 3: Sorting and Searching, Chapter 5: Sorting. Addison-Wesley Publishing Company. } \author{ HwB } \note{ At the moment, only increasingly sorting is possible (if needed apply \code{rev} afterwards). } \seealso{ \code{\link{sort}}, the internal C-based sorting routine. } \examples{ \dontrun{ testSort(100) a <- sort(runif(1000)); b <- sort(runif(1000)) system.time(y <- mergeSort(c(a, b))) system.time(y <- mergeOrdered(a, b)) is.sorted(y)} } \keyword{ array } pracma/man/std_err.Rd0000644000176200001440000000061311566455115014232 0ustar liggesusers\name{std_err} \alias{std_err} \title{Standard Error} \description{ Standard error of the values of \code{x}. } \usage{ std_err(x) } \arguments{ \item{x}{numeric vector or matrix} } \details{ Standard error is computed as \code{var(x)/length(x)}. } \value{ Returns the standard error of all elements of the vector or matrix. } \examples{ std_err(1:10) #=> 0.9574271 } \keyword{ stat } pracma/man/cross.Rd0000644000176200001440000000145212042212424013703 0ustar liggesusers\name{cross} \alias{cross} \title{Vector Cross Product} \description{ Vector or cross product } \usage{ cross(x, y) } \arguments{ \item{x}{numeric vector or matrix} \item{y}{numeric vector or matrix} } \details{ Computes the cross (or: vector) product of vectors in 3 dimensions. In case of matrices it takes the first dimension of length 3 and computes the cross product between corresponding columns or rows. The more general cross product of \code{n-1} vectors in n-dimensional space is realized as \code{crossn}. } \value{ 3-dim. vector if \code{x} and \code{<} are vectors, a matrix of 3-dim. vectors if \code{x} and \code{y} are matrices themselves. } \seealso{ \code{\link{dot}}, \code{\link{crossn}} } \examples{ cross(c(1, 2, 3), c(4, 5, 6)) # -3 6 -3 } \keyword{ array } pracma/man/hurst.Rd0000644000176200001440000000736312403264462013740 0ustar liggesusers\name{hurstexp} \alias{hurstexp} \title{ Hurst Exponent } \description{ Calculates the Hurst exponent using R/S analysis. } \usage{ hurstexp(x, d = 50, display = TRUE) } \arguments{ \item{x}{a time series.} \item{d}{smallest box size; default 50.} \item{display}{logical; shall the results be printed to the console?} } \details{ \code{hurstexp(x)} calculates the Hurst exponent of a time series \code{x} using R/S analysis, after Hurst, with slightly different approaches, or corrects it with small sample bias, see for example Weron. These approaches are a corrected R/S method, an empirical and corrected empirical method, and a try at a theoretical Hurst exponent. It should be mentioned that the results are sometimes very different, so providing error estimates will be highly questionable. Optimal sample sizes are automatically computed with a length that possesses the most divisors among series shorter than \code{x} by no more than 1 percent. } \value{ \code{hurstexp(x)} returns a list with the following components: \itemize{ \item \code{Hs} - simplified R over S approach \item \code{Hrs} - corrected R over S Hurst exponent \item \code{He} - empirical Hurst exponent \item \code{Hal} - corrected empirical Hurst exponent \item \code{Ht} - theoretical Hurst exponent } } \note{ Derived from Matlab code of R. Weron, published on Matlab Central. } \references{ H.E. Hurst (1951) Long-term storage capacity of reservoirs, Transactions of the American Society of Civil Engineers 116, 770-808. R. Weron (2002) Estimating long range dependence: finite sample properties and confidence intervals, Physica A 312, 285-299. } \seealso{ \code{fractal::hurstSpec, RoverS, hurstBlock} and \code{fArma::LrdModelling} } \examples{ ## Computing the Hurst exponent data(brown72) x72 <- brown72 # H = 0.72 xgn <- rnorm(1024) # H = 0.50 xlm <- numeric(1024); xlm[1] <- 0.1 # H = 0.43 for (i in 2:1024) xlm[i] <- 4 * xlm[i-1] * (1 - xlm[i-1]) hurstexp(brown72, d = 128) # 0.72 # Simple R/S Hurst estimation: 0.6590931 # Corrected R over S Hurst exponent: 0.7384611 # Empirical Hurst exponent: 0.7068613 # Corrected empirical Hurst exponent: 0.6838251 # Theoretical Hurst exponent: 0.5294909 hurstexp(xgn) # 0.50 # Simple R/S Hurst estimation: 0.5518143 # Corrected R over S Hurst exponent: 0.5982146 # Empirical Hurst exponent: 0.6104621 # Corrected empirical Hurst exponent: 0.5690305 # Theoretical Hurst exponent: 0.5368124 hurstexp(xlm) # 0.43 # Simple R/S Hurst estimation: 0.4825898 # Corrected R over S Hurst exponent: 0.5067766 # Empirical Hurst exponent: 0.4869625 # Corrected empirical Hurst exponent: 0.4485892 # Theoretical Hurst exponent: 0.5368124 ## Compare with other implementations \dontrun{ library(fractal) x <- x72 hurstSpec(x) # 0.776 # 0.720 RoverS(x) # 0.717 hurstBlock(x, method="aggAbs") # 0.648 hurstBlock(x, method="aggVar") # 0.613 hurstBlock(x, method="diffvar") # 0.714 hurstBlock(x, method="higuchi") # 1.001 x <- xgn hurstSpec(x) # 0.538 # 0.500 RoverS(x) # 0.663 hurstBlock(x, method="aggAbs") # 0.463 hurstBlock(x, method="aggVar") # 0.430 hurstBlock(x, method="diffvar") # 0.471 hurstBlock(x, method="higuchi") # 0.574 x <- xlm hurstSpec(x) # 0.478 # 0.430 RoverS(x) # 0.622 hurstBlock(x, method="aggAbs") # 0.316 hurstBlock(x, method="aggVar") # 0.279 hurstBlock(x, method="diffvar") # 0.547 hurstBlock(x, method="higuchi") # 0.998 } } \keyword{ timeseries } pracma/man/geo_median.Rd0000644000176200001440000000310512214146052014642 0ustar liggesusers\name{geo_median} \alias{geo_median} \title{ Geometric Median } \description{ Compute the ``geometric median'' of points in n-dimensional space, that is the point with the least sum of (Euclidean) distances to all these points. } \usage{ geo_median(P, tol = 1e-07, maxiter = 200) } \arguments{ \item{P}{matrix of points, \code{x_i}-coordinates in the ith column.} \item{tol}{relative tolerance.} \item{maxiter}{maximum number of iterations.} } \details{ The task is solved applying an iterative process, known as Weiszfeld's algorithm. The solution is unique whenever the points are not collinear. If the dimension is 1 (one column), the median will be returned. } \value{ Returns a list with components \code{p} the coordinates of the solution point, \code{d} the sum of distances to all the sample points, \code{reltol} the relative tolerance of the iterative process, and \code{niter} the number of iterations. } \references{ See Wikipedia's entry on ``Geometric median''. } \note{ This is also known as the ``1-median problem'' and can be generalized to the ``k-median problem'' for k cluster centers; see \code{kcca} in the `flexclust' package. } \seealso{ \code{\link{L1linreg}} } \examples{ # Generate 100 points on the unit sphere in the 10-dim. space set.seed(1001) P <- rands(n=100, N=9) ( sol <- geo_median(P) ) # $p # [1] -0.009481361 -0.007643410 -0.001252910 0.006437703 -0.019982885 -0.045337987 # [7] 0.036249563 0.003232175 0.035040592 0.046713023 # $d # [1] 99.6638 # $reltol # [1] 3.069063e-08 # $niter # [1] 10 } \keyword{ optimize } pracma/man/deval.Rd0000644000176200001440000000233112042212424013642 0ustar liggesusers\name{deval} \alias{deval} \title{ Evaluate ODE Solution } \description{ Evaluate solution of a differential equation solver. } \usage{ deval(x, y, xp, idx = NULL) } \arguments{ \item{x}{vector of (time) points at which the differential equation has been solved.} \item{y}{values of the function(s) that have been computed for the given (time) points.} \item{xp}{point or numeric vector at which the solution is wanted; must be sorted.} \item{idx}{index of functions whose vales shall be returned.} } \details{ Determines where the points \code{xp} lie within the vector \code{x} and interpolates linearly. } \value{ An \code{length(xp)}-by-\code{length(idx)} matrix of values at points \code{xp}. } \note{ The interpolation is linear only for the moment. } \seealso{ \code{\link{deeve}} } \examples{ ## Free fall: v' = -g - cw abs(v)^1.1, cw = 1.6 drag coefficien f <- function(t, y) -9.81 + 1.6*abs(y)^1.1 sol <- rk4(f, 0, 10, 0, 100) # speed after 0.5, 1, 1.5, 2 seconds cbind(c(0.5,1,1.5,2), -deval(sol$x, sol$y, c(0.5, 1, 1.5, 2))) # 0.5 3.272267 m/s # 1.0 4.507677 # 1.5 4.953259 # 2.0 5.112068 # plot(sol$x, -sol$y, type="l", col="blue"); grid() } \keyword{ ode } pracma/man/cond.Rd0000644000176200001440000000236611557560120013513 0ustar liggesusers\name{cond} \alias{cond} \title{ Matrix Condition } \description{ Condition number of a matrix. } \usage{ cond(M, p = 2) } \arguments{ \item{M}{Numeric matrix; vectors will be considered as column vectors.} \item{p}{Indicates the \code{p}-norm. At the moment, norms other than \code{p=2} are not implemented.} } \details{ The condition number of a matrix measures the sensitivity of the solution of a system of linear equations to small errors in the data. Values of \code{cond(M)} and \code{cond(M, p)} near \code{1} are indications of a well-conditioned matrix. } \value{ \code{cond(M)} returns the 2-norm condition number, the ratio of the largest singular value of \code{M} to the smallest. \code{c = cond(M, p)} returns the matrix condition number in \code{p}-norm: \code{norm(X,p) * norm(inv(X),p)}. (Not yet implemented.) } \references{ Trefethen, L. N., and D. Bau III. (1997). Numerical Linear Algebra. SIAM, Philadelphia. } \note{ Not feasible for large or sparse matrices as \code{svd(M)} needs to be computed. The Matlab/Octave function \code{condest} for condition estimation has not been implemented. } \seealso{ \code{\link{normest}}, \code{\link{svd}} } \examples{ cond(hilb(8)) } \keyword{ array } pracma/man/cd.Rd0000644000176200001440000000135612465405723013162 0ustar liggesusers\name{cd, pwd, what} \alias{cd} \alias{pwd} \alias{what} \title{ Directory Functions (Matlab style) } \description{ Displays or changes working directory, or lists files therein. } \usage{ cd(dname) pwd() what(dname = getwd()) } \arguments{ \item{dname}{(relative or absolute) directory path.} } \details{ \code{pwd()} displays the name of the current directory, and is the same as \code{cd()}. \code{cd(dname)} changes to directory \code{dname} and if successfull displays the directory name. \code{what()} lists all files in a directory.\cr } \value{ Name of the current working directory. } \seealso{ \code{\link{getwd}}, \code{\link{setwd}}, \code{\link{list.files}} } \examples{ # cd() # pwd() # what() } \keyword{ utilities } pracma/man/roots.Rd0000644000176200001440000000337413471575664013756 0ustar liggesusers\name{roots, polyroots} \alias{roots} \alias{rootsmult} \alias{polyroots} \title{Polynomial Roots} \description{ Computes the roots (and multiplicities) of a polynomial. } \usage{ roots(p) polyroots(p, ntol = 1e-04, ztol = 1e-08) rootsmult(p, r, tol=1e-12) } \arguments{ \item{p}{vector of real or complex numbers representing the polynomial.} \item{r}{a possible root of the polynomial.} \item{tol, ntol, ztol}{norm tolerance and accuracy for polyroots.} } \details{ The function \code{roots} computes roots of a polynomial as eigenvalues of the companion matrix. \code{polyroots} attempts to refine the results of \code{roots} with special attention to multiple roots. For a reference of this implementation see F. C. Chang, "Solving multiple-root polynomials", IEEE Antennas and Propagation Magazine Vol. 51, No. 6 (2010), pp. 151-155. \code{rootsmult} determines te order of a possible root \code{r}. As this computation is problematic in double precision, the result should be taken with a grain of salt. } \value{ \code{roots} returns a vector holding the roots of the polynomial, \code{rootsmult} the multiplicity of a root as an integer. And \code{polyroots} returns a data frame witha column 'root' and a column 'mult' giving the multiplicity of that root. } \seealso{ \code{\link{polyroot}} } \examples{ roots(c(1, 0, 1, 0, 0)) # 0 0 1i -1i p <- Poly(c(-2, -1, 0, 1, 2)) # 1*x^5 - 5*x^3 + 4*x roots(p) # 0 -2 2 -1 1 p <- Poly(c(rep(1, 4), rep(-1, 4), 0, 0)) # 1 0 -4 0 6 0 -4 0 1 rootsmult(p, 1.0); rootsmult(p, -1.0) # 4 4 polyroots(p) ## root mult ## 1 0 2 ## 2 1 4 ## 3 -1 4 } \keyword{ math } pracma/man/anms.Rd0000644000176200001440000000516613046131774013533 0ustar liggesusers\name{anms} \alias{anms} \title{ Adaptive Nelder-Mead Minimization } \description{ An implementation of the Nelder-Mead algorithm for derivative-free optimization / function minimization. } \usage{ anms(fn, x0, ..., tol = 1e-10, maxfeval = NULL) } \arguments{ \item{fn}{nonlinear function to be minimized.} \item{x0}{starting vector.} \item{tol}{relative tolerance, to be used as stopping rule.} \item{maxfeval}{maximum number of function calls.} \item{\ldots}{additional arguments to be passed to the function.} } \details{ Also called a `simplex' method for finding the local minimum of a function of several variables. The method is a pattern search that compares function values at the vertices of the simplex. The process generates a sequence of simplices with ever reducing sizes. \code{anms} can be used up to 20 or 30 dimensions (then `tol' and `maxfeval' need to be increased). It applies adaptive parameters for simplicial search, depending on the problem dimension -- see Fuchang and Lixing (2012). With upper and/or lower bounds, \code{anms} will apply a transformation of bounded to unbounded regions before utilizing Nelder-Mead. Of course, if the optimum is near to the boundary, results will not be as accurate as when the minimum is in the interior. } \value{ List with following components: \item{xmin}{minimum solution found.} \item{fmin}{value of \code{f} at minimum.} \item{nfeval}{number of function calls performed.} } \references{ Nelder, J., and R. Mead (1965). A simplex method for function minimization. Computer Journal, Volume 7, pp. 308-313. O'Neill, R. (1971). Algorithm AS 47: Function Minimization Using a Simplex Procedure. Applied Statistics, Volume 20(3), pp. 338-345. J. C. Lagarias et al. (1998). Convergence properties of the Nelder-Mead simplex method in low dimensions. SIAM Journal for Optimization, Vol. 9, No. 1, pp 112-147. Fuchang Gao and Lixing Han (2012). Implementing the Nelder-Mead simplex algorithm with adaptive parameters. Computational Optimization and Applications, Vol. 51, No. 1, pp. 259-277. } \note{ Copyright (c) 2012 by F. Gao and L. Han, implemented in Matlab with a permissive license. Implemented in R by Hans W. Borchers. For another elaborate implementation of Nelder-Mead see the package `dfoptim'. } \seealso{ \code{\link{optim}} } \examples{ ## Rosenbrock function rosenbrock <- function(x) { n <- length(x) x1 <- x[2:n] x2 <- x[1:(n-1)] sum(100*(x1-x2^2)^2 + (1-x2)^2) } anms(rosenbrock, c(0,0,0,0,0)) # $xmin # [1] 1 1 1 1 1 # $fmin # [1] 8.268732e-21 # $nfeval # [1] 1153 } \keyword{ optimize } pracma/man/rkf54.Rd0000644000176200001440000000531212626000703013507 0ustar liggesusers\name{rkf54} \alias{rkf54} \title{ Runge-Kutta-Fehlberg } \description{ Runge-Kutta-Fehlberg with adaptive step size. } \usage{ rkf54(f, a, b, y0, tol = .Machine$double.eps^0.5, control = list(), ...) } \arguments{ \item{f}{function in the differential equation \eqn{y' = f(x, y)}.} \item{a, b}{endpoints of the interval.} \item{y0}{starting values at \code{a}.} \item{tol}{relative tolerance, used for determining the step size.} \item{control}{list for influencing the step size with components\cr \code{hmin, hmax}, the minimal, maximal step size\cr \code{jmax}, the maximally allowed number of steps.} \item{\ldots}{additional parameters to be passed to the function.} } \details{ Runge-Kutta-Fehlberg is a kind of Runge-Kutta method of solving ordinary differential equations of order (5, 4) with variable step size. ``At each step, two different approximations for the solution are made and compared. If the two answers are in close agreement, the approximation is accepted. If the two answers do not agree to a specified accuracy, the step size is reduced. If the answers agree to more significant digits than required, the step size is increased.'' Some textbooks promote the idea to use the five-order formula as the accepted value instead of using it for error estimation. This approach is taken here, that is why the function is called \code{rkf54}. The idea is still debated as the accuracy determinations appears to be diminished. } \value{ List with components \code{x} for grid points between \code{a} and \code{b} and \code{y} the function values of the numerical solution. } \references{ Stoer, J., and R. Bulirsch (2002). Introduction to Numerical Analysis. Third Edition, Springer-Verlag, New York. Mathematica code associated with the book:\cr Mathews, J. H., and K. D. Fink (2004). Numerical Methods Using Matlab. Fourth Edition, Prentice Hall. } \note{ This function serves demonstration purposes only. } \seealso{ \code{\link{rk4}}, \code{\link{ode23}} } \examples{ # Example: y' = 1 + y^2 f1 <- function(x, y) 1 + y^2 sol11 <- rkf54(f1, 0, 1.1, 0.5, control = list(hmin = 0.01)) sol12 <- rkf54(f1, 0, 1.1, 0.5, control = list(jmax = 250)) # Riccati equation: y' = x^2 + y^2 f2 <- function(x, y) x^2 + y^2 sol21 <- rkf54(f2, 0, 1.5, 0.5, control = list(hmin = 0.01)) sol22 <- rkf54(f2, 0, 1.5, 0.5, control = list(jmax = 250)) \dontrun{ plot(0, 0, type = "n", xlim = c(0, 1.5), ylim = c(0, 20), main = "Riccati", xlab = "", ylab = "") points(sol11$x, sol11$y, pch = "*", col = "darkgreen") lines(sol12$x, sol12$y) points(sol21$x, sol21$y, pch = "*", col = "blue") lines(sol22$x, sol22$y) grid()} } \keyword{ ode } pracma/man/polyval.Rd0000644000176200001440000000233413116316453014252 0ustar liggesusers\name{polyval, polyvalm} \alias{polyval} \alias{polyvalm} \title{Evaluating a Polynomial} \description{ Evaluate polynomial on vector or matrix. } \usage{ polyval(p, x) polyvalm(p, A) } \arguments{ \item{p}{vector representing a polynomial.} \item{x}{vector of values where to evaluate the polynomial.} \item{A}{matrix; needs to be square.} } \details{ \code{polyval} valuates the polynomial given by \code{p} at the values specified by the elements of \code{x}. If \code{x} is a matrix, the polynomial will be evaluated at each element and a matrix returned. \code{polyvalm} will evaluate the polynomial in the matrix sense, i.e., matrix multiplication is used instead of element by element multiplication as used in 'polyval'. The argument matrix \code{A} must be a square matrix. } \value{ Vector of values, resp. a matrix. } \seealso{ \code{\link{poly}}, \code{\link{roots}} } \examples{ # Evaluate 3 x^2 + 2 x + 1 at x = 5, 7, and 9 p = c(3, 2, 1); polyval(p, c(5, 7, 9)) # 86 162 262 # Apply the characteristic polynomial to its matrix A <- pascal(4) p <- pracma::Poly(A) # characteristic polynomial of A polyvalm(p, A) # almost zero 4x4-matrix } \keyword{ math } pracma/man/quadv.Rd0000644000176200001440000000251212062032441013671 0ustar liggesusers\name{quadv} \alias{quadv} \title{ Vectorized Integration } \description{ Vectorized adaptive Simpson integration. } \usage{ quadv(f, a, b, tol = .Machine$double.eps^(1/2), ...) } \arguments{ \item{f}{univariate, vector-valued function; need not be vectorized.} \item{a, b}{endpoints of the integration interval.} \item{tol}{acuracy required for the recursion step.} \item{\dots}{further parameters to be passed to the function \code{f}.} } \details{ Recursive version of the adaptive Simpson quadrature, recursion is based on the maximum of all components of the function calls. \code{quad} is not suitable for functions with singularities in the interval or at end points. } \value{ Returns a list with components \code{Q} the integral value, \code{fcnt} the number of function calls, and \code{estim.prec} the estimated precision that normally will be much too high. } \seealso{ \code{\link{quad}} } \examples{ ## Examples f1 <- function(x) c(sin(x), cos(x)) quadv(f1, 0, pi) # $Q # [1] 2.000000e+00 1.110223e-16 # $fcnt # [1] 65 # $estim.prec # [1] 4.321337e-07 f2 <- function(x) x^c(1:10) quadv(f2, 0, 1, tol = 1e-12) # $Q # [1] 0.50000000 0.33333333 0.25000000 0.20000000 0.16666667 # [6] 0.14285714 0.12500000 0.11111111 0.10000000 0.09090909 # $fcnt # [1] 505 # $estim.prec # [1] 2.49e-10 } \keyword{ math } pracma/man/nearest_spd.Rd0000644000176200001440000000176712740250175015104 0ustar liggesusers\name{nearest_spd} \alias{nearest_spd} \title{ Nearest Symmetric Positive-definite Matrix } \description{ Find nearest (in Frobenius norm) symmetric positive-definite matrix to A. } \usage{ nearest_spd(A) } \arguments{ \item{A}{square numeric matrix.} } \details{ "The nearest symmetric positive semidefinite matrix in the Frobenius norm to an arbitrary real matrix A is shown to be (B + H)/2, where H is the symmetric polar factor of B=(A + A')/2."\cr N. J. Highham } \value{ Returns a matrix of the same size. } \references{ Nicholas J. Higham (1988). Computing a nearest symmetric positive semidefinite matrix. Linear Algebra and its Applications. Vol. 103, pp.103-118. } \seealso{ \code{\link{randortho}}, \code{\link{procrustes}} } \examples{ A <- matrix(1:9, 3, 3) B <- nearest_spd(A); B # [,1] [,2] [,3] # [1,] 2.034900 3.202344 4.369788 # [2,] 3.202344 5.039562 6.876781 # [3,] 4.369788 6.876781 9.383774 norm(B - A, type = 'F') # [1] 3.758517 } \keyword{ array } pracma/man/odregress.Rd0000644000176200001440000000453414000041732014551 0ustar liggesusers\name{odregress} \alias{odregress} \title{ Orthogonal Distance Regression } \description{ Orthogonal Distance Regression (ODR, a.k.a. total least squares) is a regression technique in which observational errors on both dependent and independent variables are taken into account. } \usage{ odregress(x, y) } \arguments{ \item{x}{matrix of independent variables.} \item{y}{vector representing dependent variable.} } \details{ The implementation used here is applying PCA resp. the singular value decomposition on the matrix of independent and dependent variables. } \value{ Returns list with components \code{coeff} linear coefficients and intercept term, \code{ssq} sum of squares of orthogonal distances to the linear line or hyperplane, \code{err} the orthogonal distances, \code{fitted} the fitted values, \code{resid} the residuals, and \code{normal} the normal vector to the hyperplane. } \references{ Golub, G.H., and C.F. Van Loan (1980). An analysis of the total least squares problem.\cr Numerical Analysis, Vol. 17, pp. 883-893. See ODRPACK or ODRPACK95 (TOMS Algorithm 676).\cr URL: https://docs.scipy.org/doc/external/odr_ams.pdf } \note{ The ``geometric mean" regression not implemented because questionable. } \seealso{ \code{\link{lm}} } \examples{ # Example in one dimension x <- c(1.0, 0.6, 1.2, 1.4, 0.2) y <- c(0.5, 0.3, 0.7, 1.0, 0.2) odr <- odregress(x, y) ( cc <- odr$coeff ) # [1] 0.65145762 -0.03328271 lm(y ~ x) # Coefficients: # (Intercept) x # -0.01379 0.62931 # Prediction xnew <- seq(0, 1.5, by = 0.25) ( ynew <- cbind(xnew, 1) \%*\% cc ) \dontrun{ plot(x, y, xlim=c(0, 1.5), ylim=c(0, 1.2), main="Orthogonal Regression") abline(lm(y ~ x), col="blue") lines(c(0, 1.5), cc[1]*c(0, 1.5) + cc[2], col="red") points(xnew, ynew, col = "red") grid()} # Example in two dimensions x <- cbind(c(0.92, 0.89, 0.85, 0.05, 0.62, 0.55, 0.02, 0.73, 0.77, 0.57), c(0.66, 0.47, 0.40, 0.23, 0.17, 0.09, 0.92, 0.06, 0.09, 0.60)) y <- x \%*\% c(0.5, 1.5) + 1 odr <- odregress(x, y); odr # $coeff # [1] 0.5 1.5 1.0 # $ssq # [1] 1.473336e-31 y <- y + rep(c(0.1, -0.1), 5) odr <- odregress(x, y); odr # $coeff # [1] 0.5921823 1.6750269 0.8803822 # $ssq # [1] 0.02168174 lm(y ~ x) # Coefficients: # (Intercept) x1 x2 # 0.9153 0.5671 1.6209 } \keyword{ fitting } pracma/man/hessenberg.Rd0000644000176200001440000000301313070014412014671 0ustar liggesusers\name{hessenberg} \alias{hessenberg} \title{ Hessenberg Matrix } \description{ Generates the Hessenberg matrix for A. } \usage{ hessenberg(A) } \arguments{ \item{A}{square matrix} } \details{ An (upper) Hessenberg matrix has zero entries below the first subdiagonal. The function generates a Hessenberg matrix \code{H} and a unitary matrix \code{P} (a similarity transformation) such that \code{A = P * H * t(P)}. The Hessenberg matrix has the same eigenvalues. If \code{A} is symmetric, its Hessenberg form will be a tridiagonal matrix. } \value{ Returns a list with two elements, \item{H}{the upper Hessenberg Form of matrix A.} \item{H}{a unitary matrix.} } \references{ Press, Teukolsky, Vetterling, and Flannery (2007). Numerical Recipes: The Art of Scientific Computing. 3rd Edition, Cambridge University Press. (Section 11.6.2) } \seealso{ \code{\link{householder}} } \examples{ A <- matrix(c(-149, -50, -154, 537, 180, 546, -27, -9, -25), nrow = 3, byrow = TRUE) hb <- hessenberg(A) hb ## $H ## [,1] [,2] [,3] ## [1,] -149.0000 42.20367124 -156.316506 ## [2,] -537.6783 152.55114875 -554.927153 ## [3,] 0.0000 0.07284727 2.448851 ## ## $P ## [,1] [,2] [,3] ## [1,] 1 0.0000000 0.0000000 ## [2,] 0 -0.9987384 0.0502159 ## [3,] 0 0.0502159 0.9987384 hb$P \%*\% hb$H \%*\% t(hb$P) ## [,1] [,2] [,3] ## [1,] -149 -50 -154 ## [2,] 537 180 546 ## [3,] -27 -9 -25 } \keyword{ array } pracma/man/blkdiag.Rd0000644000176200001440000000131512001517521014146 0ustar liggesusers\name{blkdiag} \alias{blkdiag} \title{ Block Diagonal Matrix } \description{ Build a block diagonal matrix. } \usage{ blkdiag(...) } \arguments{ \item{\dots}{sequence of non-empty, numeric matrices} } \details{ Generate a block diagonal matrix from A, B, C, .... All the arguments must be numeric and non-empty matrices. } \value{ a numeric matrix } \note{ Vectors as input have to be converted to matrices before. Note that \code{as.matrix(v)} with \code{v} a vector will generate a column vector; use \code{matrix(v, nrow=1)} if a row vector is intended. } \seealso{ \code{\link{Diag}} } \examples{ a1 <- matrix(c(1,2), 1) a2 <- as.matrix(c(1,2)) blkdiag(a1, diag(1, 2, 2), a2) } \keyword{ array } pracma/man/chebCoeff.Rd0000644000176200001440000000255614000041732014422 0ustar liggesusers\name{chebCoeff} \alias{chebCoeff} \title{Chebyshev Polynomials} \description{ Chebyshev Coefficients for Chebyshev polynomials of the first kind. } \usage{ chebCoeff(fun, a, b, n) } \arguments{ \item{fun}{function to be approximated.} \item{a, b}{endpoints of the interval.} \item{n}{an integer \code{>= 0}.} } \details{ For a function \code{fun} on on the interval \code{[a, b]} determines the coefficients of the Chebyshev polynomials up to degree \code{n} that will approximate the function (in L2 norm). } \value{ Vector of coefficients for the Chebyshev polynomials, from low to high degrees (see the example). } \references{ Weisstein, Eric W. ``Chebyshev Polynomial of the First Kind." From MathWorld --- A Wolfram Web Resource. \url{https://mathworld.wolfram.com/ChebyshevPolynomialoftheFirstKind.html} } \note{ See the ``Chebfun Project'' by Nick Trefethen. } \seealso{ \code{\link{chebPoly}}, \code{\link{chebApprox}} } \examples{ ## Chebyshev coefficients for x^2 + 1 n <- 4 f2 <- function(x) x^2 + 1 cC <- chebCoeff(f2, -1, 1, n) # 3.0 0 0.5 0 0 cC[1] <- cC[1]/2 # correcting the absolute Chebyshev term # i.e. 1.5*T_0 + 0.5*T_2 cP <- chebPoly(n) # summing up the polynomial coefficients p <- cC \%*\% cP # 0 0 1 0 1 } \keyword{ math } pracma/man/blanks.Rd0000644000176200001440000000056511545666512014052 0ustar liggesusers\name{blanks} \alias{blanks} \title{String of Blank Carakters} \description{ Create a string of blank characters. } \usage{ blanks(n) } \arguments{ \item{n}{integer greater or equal to 0.} } \details{ \code{blanks(n)} is a string of \code{n} blanks. } \value{ String of \code{n} blanks. } \seealso{ \code{\link{deblank}} } \examples{ blanks(6) } \keyword{ string } pracma/man/factors.Rd0000644000176200001440000000160412042212424014212 0ustar liggesusers\name{factors} \alias{factors} \title{Prime Factors} \description{ Returns a vector containing the prime factors of \code{n}. } \usage{ factors(n) } \arguments{ \item{n}{nonnegative integer} } \details{ Computes the prime factors of \code{n} in ascending order, each one as often as its multiplicity requires, such that \code{n == prod(factors(n))}. The corresponding Matlab function is called `factor', but because factors have a special meaning in R and the factor() function in R could not (or should not) be shadowed, the number theoretic function has been renamed here. } \value{ Vector containing the prime factors of \code{n}. } \seealso{ \code{\link{isprime}, \link{primes}} } \examples{ \dontrun{ factors(1002001) # 7 7 11 11 13 13 factors(65537) # is prime # Euler's calculation factors(2^32 + 1) # 641 6700417} } \keyword{ math } pracma/man/gaussNewton.Rd0000644000176200001440000000614712204446562015111 0ustar liggesusers\name{gaussNewton} \alias{gaussNewton} \title{Gauss-Newton Function Minimization} \description{ Gauss-Newton method of minimizing a term \eqn{f_1(x)^2 + \ldots + f_m(x)^2} or \eqn{F' F} where \eqn{F = (f_1, \ldots, f_m)} is a multivariate function of \eqn{n} variables, not necessarily \eqn{n = m}. } \usage{ gaussNewton(x0, Ffun, Jfun = NULL, maxiter =100, tol = .Machine$double.eps^(1/2), ...) } \arguments{ \item{Ffun}{\code{m} functions of \code{n} variables.} \item{Jfun}{function returning the Jacobian matrix of \code{Ffun}; if \code{NULL}, the default, the Jacobian will be computed numerically. The gradient of \code{f} will be computed internally from the Jacobian (i.e., cannot be supplied).} \item{x0}{Numeric vector of length \code{n}.} \item{maxiter}{Maximum number of iterations.} \item{tol}{Tolerance, relative accuracy.} \item{...}{Additional parameters to be passed to f.} } \details{ Solves the system of equations applying the Gauss-Newton's method. It is especially designed for minimizing a sum-of-squares of functions and can be used to find a common zero of several function. This algorithm is described in detail in the textbook by Antoniou and Lu, incl. different ways to modify and remedy the Hessian if not being positive definite. Here, the approach by Goldfeld, Quandt and Trotter is used, and the hessian modified by the Matthews and Davies algorithm if still not invertible. To accelerate the iteration, an inexact linesearch is applied. } \value{ List with components:\cr \code{xs} the minimum or root found so far,\cr \code{fs} the square root of sum of squares of the values of f,\cr \code{iter} the number of iterations needed, and\cr \code{relerr} the absoulte distance between the last two solutions. } \references{ Antoniou, A., and W.-S. Lu (2007). Practical Optimization: Algorithms and Engineering Applications. Springer Business+Science, New York. } \note{ If \code{n=m} then directly applying the \code{newtonsys} function might be a better alternative. } \seealso{ \code{\link{newtonsys}}, \code{\link{softline}} } \examples{ f1 <- function(x) c(x[1]^2 + x[2]^2 - 1, x[1] + x[2] - 1) gaussNewton(c(4, 4), f1) f2 <- function(x) c( x[1] + 10*x[2], sqrt(5)*(x[] - x[4]), (x[2] - 2*x[3])^2, 10*(x[1] - x[4])^2) gaussNewton(c(-2, -1, 1, 2), f2) f3 <- function(x) c(2*x[1] - x[2] - exp(-x[1]), -x[1] + 2*x[2] - exp(-x[2])) gaussNewton(c(0, 0), f3) # $xs 0.5671433 0.5671433 f4 <- function(x) # Dennis Schnabel c(x[1]^2 + x[2]^2 - 2, exp(x[1] - 1) + x[2]^3 - 2) gaussNewton(c(2.0, 0.5), f4) # $xs 1 1 ## Examples (from Matlab) F1 <- function(x) c(2*x[1]-x[2]-exp(-x[1]), -x[1]+2*x[2]-exp(-x[2])) gaussNewton(c(-5, -5), F1) # Find a matrix X such that X %*% X %*% X = [1 2; 3 4] F2 <- function(x) { X <- matrix(x, 2, 2) D <- X \%*\% X \%*\% X - matrix(c(1,3,2,4), 2, 2) return(c(D)) } sol <- gaussNewton(ones(2,2), F2) (X <- matrix(sol$xs, 2, 2)) # [,1] [,2] # [1,] -0.1291489 0.8602157 # [2,] 1.2903236 1.1611747 X \%*\% X \%*\% X } \keyword{ math } pracma/man/fminunc.Rd0000644000176200001440000000314513400317701014215 0ustar liggesusers\name{fminunc} \alias{fminunc} \title{ Minimize Unconstrained Multivariable Function } \description{ Find minimum of unconstrained multivariable functions. } \usage{ fminunc(x0, fn, gr = NULL, ..., tol = 1e-08, maxiter = 0, maxfeval = 0) } \arguments{ \item{x0}{starting point.} \item{fn}{objective function to be minimized.} \item{gr}{gradient function of the objective.} \item{...}{additional parameters to be passed to the function.} \item{tol}{relative tolerance.} \item{maxiter}{maximum number of iterations.} \item{maxfeval}{maximum number of function evaluations.} } \details{ The method used here for unconstrained minimization is a variant of a "variable metric" resp. quasi-Newton approach. } \value{ List with the following components: \item{par}{the best minimum found.} \item{value}{function value at the minimum.} \item{counts}{number of function and gradient calls.} \item{convergence}{integer indicating the terminating situation.} \item{message}{description of the final situation.} } \references{ J. Nocedal and S. J. Wright (2006). Numerical Optimization. Second Edition, Springer Science+Business Media, New York. } \note{ \code{fminunc} mimics the Matlab function of the same name. } \author{ The "variable metric" code provided by John Nash (package Rvmmin), stripped-down version by Hans W. Borchers. } \seealso{ \code{\link{fminsearch}}, \code{\link{fmincon}}, } \examples{ fun = function(x) x[1]*exp(-(x[1]^2 + x[2]^2)) + (x[1]^2 + x[2]^2)/20 fminunc(x0 = c(1, 2), fun) ## xmin: c(-0.6691, 0.0000); fmin: -0.4052 } \keyword{ optimize } pracma/man/strrep.Rd0000644000176200001440000000141312546667755014124 0ustar liggesusers\name{strRep} \alias{strRep} \title{ Find and replace substring } \description{ Find and replace all occurrences of a substring with another one in all strings of a character vector. } \usage{ strRep(s, old, new) } \arguments{ \item{s}{Character vector.} \item{old}{String to be replaced.} \item{new}{String that replaces another one.} } \details{ Replaces all occurrences of \code{old} with \code{new} in all strings of character vector \code{s}. The matching is case sensitive. } \value{ A character vector of the same length. } \seealso{ \code{\link{gsub}}, \code{regexprep} } \examples{ S <- c('This is a good example.', "He has a good character.", 'This is good, good food.', "How goodgood this is!") strRep(S, 'good', 'great') } \keyword{ string } pracma/man/neldermead.Rd0000644000176200001440000001021113377264142014663 0ustar liggesusers\name{nelder_mead} \alias{nelder_mead} \title{ Nelder-Mead Function Minimization Method } \description{ An implementation of the Nelder-Mead algorithm for derivative-free optimization / function minimization. } \usage{ nelder_mead(fn, x0, ..., adapt = TRUE, tol = 1e-08, maxfeval = 5000, step = rep(1.0, length(x0))) } \arguments{ \item{fn}{nonlinear function to be minimized.} \item{x0}{starting point for the iteration.} \item{...}{additional arguments to be passed to the function.} \item{adapt}{logical; adapt to parameter dimension.} \item{tol}{terminating limit for the variance of function values; can be made *very* small, like \code{tol=1e-50}.} \item{maxfeval}{maximum number of function evaluations.} \item{step}{size and shape of initial simplex; relative magnitudes of its elements should reflect the units of the variables.} } \details{ Also called a `simplex' method for finding the local minimum of a function of several variables. The method is a pattern search that compares function values at the vertices of the simplex. The process generates a sequence of simplices with ever reducing sizes. The simplex function minimisation procedure due to Nelder and Mead (1965), as implemented by O'Neill (1971), with subsequent comments by Chambers and Ertel 1974, Benyon 1976, and Hill 1978. For another elaborate implementation of Nelder-Mead in R based on Matlab code by Kelley see package `dfoptim'. \code{nelder_mead} can be used up to 20 dimensions (then `tol' and `maxfeval' need to be increased). With \code{adapt=TRUE} it applies adaptive coefficients for the simplicial search, depending on the problem dimension -- see Fuchang and Lixing (2012). This approach especially reduces the number of function calls. } \value{ List with following components: \item{xmin}{minimum solution found.} \item{fmin}{value of \code{f} at minimum.} \item{fcount}{number of iterations performed.} \item{restarts}{number of restarts.} \item{errmess}{error message} } \references{ Nelder, J., and R. Mead (1965). A simplex method for function minimization. Computer Journal, Volume 7, pp. 308-313. O'Neill, R. (1971). Algorithm AS 47: Function Minimization Using a Simplex Procedure. Applied Statistics, Volume 20(3), pp. 338-345. J. C. Lagarias et al. (1998). Convergence properties of the Nelder-Mead simplex method in low dimensions. SIAM Journal for Optimization, Vol. 9, No. 1, pp 112-147. Fuchang Gao and Lixing Han (2012). Implementing the Nelder-Mead simplex algorithm with adaptive parameters. Computational Optimization and Applications, Vol. 51, No. 1, pp. 259-277. } \note{ Original FORTRAN77 version by R O'Neill; MATLAB version by John Burkardt under LGPL license. Re-implemented in R by Hans W. Borchers. } \seealso{ \code{\link{hooke_jeeves}} } \examples{ ## Classical tests as in the article by Nelder and Mead # Rosenbrock's parabolic valley rpv <- function(x) 100*(x[2] - x[1]^2)^2 + (1 - x[1])^2 x0 <- c(-2, 1) nelder_mead(rpv, x0) # 1 1 # Fletcher and Powell's helic valley fphv <- function(x) 100*(x[3] - 10*atan2(x[2], x[1])/(2*pi))^2 + (sqrt(x[1]^2 + x[2]^2) - 1)^2 +x[3]^2 x0 <- c(-1, 0, 0) nelder_mead(fphv, x0) # 1 0 0 # Powell's Singular Function (PSF) psf <- function(x) (x[1] + 10*x[2])^2 + 5*(x[3] - x[4])^2 + (x[2] - 2*x[3])^4 + 10*(x[1] - x[4])^4 x0 <- c(3, -1, 0, 1) # needs maximum number of function calls nelder_mead(psf, x0, maxfeval=30000) # 0 0 0 0 \dontrun{ # Can run Rosenbrock's function in 30 dimensions in one and a half minutes: nelder_mead(fnRosenbrock, rep(0, 30), tol=1e-20, maxfeval=10^7) # $xmin # [1] 0.9999998 1.0000004 1.0000000 1.0000001 1.0000000 1.0000001 # [7] 1.0000002 1.0000001 0.9999997 0.9999999 0.9999997 1.0000000 # [13] 0.9999999 0.9999994 0.9999998 0.9999999 0.9999999 0.9999999 # [19] 0.9999999 1.0000001 0.9999998 1.0000000 1.0000003 0.9999999 # [25] 1.0000000 0.9999996 0.9999995 0.9999990 0.9999973 0.9999947 # $fmin # [1] 5.617352e-10 # $fcount # [1] 1426085 # elapsed time is 96.008000 seconds } } \keyword{ optimize } pracma/man/randperm.Rd0000644000176200001440000000140611731165602014372 0ustar liggesusers\name{randperm} \alias{randperm} \title{ Random Permutation } \description{ Generates a random permutation. } \usage{ randperm(a, k) } \arguments{ \item{a}{integer or numeric vector of some length \code{n}.} \item{k}{integer, smaller as \code{a} or \code{length(a)}.} } \details{ Generates one random permutation of \code{k} of the elements \code{a}, if \code{a} is a vector, or of \code{1:a} if \code{a} is a single integer. } \value{ Vector of permuted elements of \code{a} or \code{1:a}. } \note{ This behavior is different from Matlab/Octave, but does better correspond with the behavior of the perms() function. } \seealso{ \code{\link{perms}} } \examples{ randperm(1:6, 3) randperm(6, 6) randperm(11:20, 5) randperm(seq(2, 10, by=2)) } \keyword{ arith } pracma/man/mod.Rd0000644000176200001440000000243212114374201013332 0ustar liggesusers\name{mod, rem} \alias{mod} \alias{rem} \alias{idivide} \title{Integer Division} \description{ Integer division functions and remainders } \usage{ mod(n, m) rem(n, m) idivide(n, m, rounding = c("fix", "floor", "ceil", "round")) } \arguments{ \item{n}{numeric vector (preferably of integers)} \item{m}{must be a scalar integer (positive, zero, or negative)} \item{rounding}{rounding mode.} } \details{ \code{mod(n, m)} is the modulo operator and returns \eqn{n\,mod\,m}. \code{mod(n, 0)} is \code{n}, and the result always has the same sign as \code{m}. \code{rem(n, m)} is the same modulo operator and returns \eqn{n\,mod\,m}. \code{mod(n, 0)} is \code{NaN}, and the result always has the same sign as \code{n}. \code{idivide(n, m)} is integer division, with the same effect as \code{n \%/\% m} or using an optional rounding mode. } \value{ a numeric (integer) value or vector/matrix. } \note{ The following relation is fulfilled (for \code{m != 0}): \code{mod(n, m) = n - m * floor(n/m)} } \seealso{ Binary R operators \code{\%/\%} and \code{\%\%}. } \examples{ mod(c(-5:5), 5) rem(c(-5:5), 5) idivide(c(-2, 2), 3, "fix") # 0 0 idivide(c(-2, 2), 3, "floor") # -1 0 idivide(c(-2, 2), 3, "ceil") # 0 1 idivide(c(-2, 2), 3, "round") # -1 1 } \keyword{ arith } pracma/man/legendre.Rd0000644000176200001440000000333712206640623014353 0ustar liggesusers\name{legendre} \alias{legendre} \title{ Legendre Functions (Matlab Style) } \description{ Calculate the values of (associated) Legendre functions. } \usage{ legendre(n, x) } \arguments{ \item{n}{degree of the Legendre polynomial involved.} \item{x}{real points to evaluate Legendre's functions at.} } \details{ \code{legendre(n,x)} computes the associated Legendre functions of degree \code{n} and order \code{m=0,1,...,n}, evaluated for each element of \code{x} where \code{x} must contain real values in \code{[-1,1]}. If \code{x} is a vector, then \code{L=legendre(n,x)} is an \code{(n+1)}-by-\code{N} matrix, where \code{N=length(x)}. Each element \code{L[m+1,i]} corresponds to the associated Legendre function of degree \code{legendre(n,x)} and order \code{m} evaluated at \code{x[i]}. Note that the first row of \code{L} is the Legendre polynomial evaluated at \code{x}. } \value{ Returns a matrix of size \code{(n+1)}-by-\code{N} where \code{N=length(x)}. } \note{ Legendre functions are solutions to Legendre's differential equation (it occurs when solving Laplace's equation in spherical coordinates). } \seealso{ \code{\link{chebPoly}} } \examples{ x <- c(0.0, 0.1, 0.2) legendre(2, x) # [,1] [,2] [,3] # [1,] -0.5 -0.4850000 -0.4400000 # [2,] 0.0 -0.2984962 -0.5878775 # [3,] 3.0 2.9700000 2.8800000 \dontrun{ x <- seq(0, 1, len = 50) L <- legendre(2, x) plot(x, L[1, ], type = "l", col = 1, ylim = c(-2, 3), ylab = "y", main = "Legendre Functions of degree 2") lines(x, L[2, ], col = 2) lines(x, L[3, ], col = 3) grid()} ## Generate Legendre's Polynomial as function # legendre_P <- function(n, x) { # L <- legendre(n, x) # return(L[1, ]) # } } \keyword{ math } pracma/man/nnz.Rd0000644000176200001440000000046611670172133013373 0ustar liggesusers\name{nnz} \alias{nnz} \title{Nonzero Elements} \description{ Number of non-zero elements. } \usage{ nnz(x) } \arguments{ \item{x}{a numeric or complex vector or matrix.} } \value{ the number of non-zero elements of \code{x}. } \seealso{ \code{\link{find}} } \examples{ nnz(diag(10)) } \keyword{array} pracma/man/hyperbolic.Rd0000644000176200001440000000176412057642712014735 0ustar liggesusers\name{coth,csch,sech, etc.} \alias{coth} \alias{csch} \alias{sech} \alias{acoth} \alias{acsch} \alias{asech} \title{ More Hyperbolic Functions } \description{ More hyperbolic functions not available in R. } \usage{ coth(z) csch(z) sech(z) acoth(z) acsch(z) asech(z) } \arguments{ \item{z}{numeric or complex scalar or vector.} } \details{ The usual hyperbolic cotangens, cosecans, and secans functions and their inverses, computed through the other well known -- in R -- hyperbolic sine, cosine, and tangens functions. } \value{ Result vector of numeric or complex values. } \note{ These function names are available in Matlab, that is the reason they have been added to the `pracma' package. } \seealso{ Trigonometric and hyperbolic functions in R. } \examples{ coth(1+1i) # 0.8680 - 0.2176i csch(1+1i) # 0.3039 - 0.6215i sech(1+1i) # 0.4983 - 0.5911i acoth(1+1i) # 0.4024 - 0.5536i acsch(1+1i) # 0.5306 - 0.4523i asech(1+1i) # 0.5306 - 1.1185i } \keyword{ math } pracma/man/runge.Rd0000644000176200001440000000163711562173556013721 0ustar liggesusers\name{runge} \alias{runge} \title{Runge Function} \description{ Runge's test function for interpolation techniques. } \usage{ runge(x) } \arguments{ \item{x}{numeric scalar.} } \details{ Runge's function is a classical test function for interpolation and and approximation techniques, especially for equidistant nodes. For example, when approximating the Runge function on the interval \code{[-1, 1]}, the error at the endpoints will diverge when the number of nodes is increasing. } \value{ Numerical value of the function. } \seealso{ \code{\link{fnorm}} } \examples{ \dontrun{ x <- seq(-1, 1, length.out = 101) y <- runge(x) plot(x, y, type = "l", lwd = 2, col = "navy", ylim = c(-0.2, 1.2)) grid() n <- c(6, 11, 16) for (i in seq(along=n)) { xp <- seq(-1, 1, length.out = n[i]) yp <- runge(xp) p <- polyfit(xp, yp, n[i]-1) y <- polyval(p, x) lines(x, y, lty=i) } } } \keyword{ math } pracma/man/histc.Rd0000644000176200001440000000423212146466630013702 0ustar liggesusers\name{histc} \alias{histc} \title{ Histogram Count (Matlab style) } \description{ Histogram-like counting. } \usage{ histc(x, edges) } \arguments{ \item{x}{numeric vector or matrix.} \item{edges}{numeric vector of grid points, must be monotonically non-decreasing.} } \details{ \code{n = histc(x,edges)} counts the number of values in vector \code{x} that fall between the elements in the \code{edges} vector (which must contain monotonically nondecreasing values). \code{n} is a \code{length(edges)} vector containing these counts. If \code{x} is a matrix then \code{cnt} and \code{bin} are matrices too, and \code{ for (j in (1:n)) cnt[k,j] <- sum(bin[, j] == k) } } \value{ returns a list with components \code{cnt} and \code{bin}. \code{n(k)} counts the number of values in \code{x} that lie between \code{edges(k) <= x(i) < edges(k+1)}. The last counts any values of \code{x} that match \code{edges(n)}. Values outside the values in edges are not counted. Use \code{-Inf} and \code{Inf} in edges to include all values. \code{bin[i]} returns \code{k} if \code{edges(k) <= x(i) < edges(k+1)}, and \code{0} if \code{x[i]} lies outside the grid. } \seealso{ \code{\link{hist}}, code{\link{histss}}, \code{\link{findInterval}} } \examples{ x <- seq(0.0, 1.0, by = 0.05) e <- seq(0.1, 0.9, by = 0.10) histc(x, e) # $cnt # [1] 2 2 2 2 2 2 2 2 1 # $bin # [1] 0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 0 0 \dontrun{ # Compare findInterval(x, e) # [1] 0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 9 findInterval(x, e, all.inside = TRUE) # [1] 1 1 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 8 8 8 # cnt[i] <- sum(findInterval(x, e) == i)} x <- matrix( c(0.5029, 0.2375, 0.2243, 0.8495, 0.0532, 0.1644, 0.4215, 0.4135, 0.7854, 0.0879, 0.1221, 0.6170), 3, 4, byrow = TRUE) e <- seq(0.0, 1.0, by = 0.2) histc(x, e) # $cnt # [,1] [,2] [,3] [,4] # [1,] 1 2 1 0 # [2,] 0 1 1 0 # [3,] 1 0 1 1 # [4,] 1 0 0 1 # [5,] 0 0 0 1 # [6,] 0 0 0 0 # # $bin # [,1] [,2] [,3] [,4] # [1,] 3 2 2 5 # [2,] 1 1 3 3 # [3,] 4 1 1 4 } \keyword{ manip } pracma/man/fzero.Rd0000644000176200001440000000356513342034603013713 0ustar liggesusers\name{fzero} \alias{fzero} \title{ Root Finding Algorithm } \description{ Find root of continuous function of one variable. } \usage{ fzero(fun, x, maxiter = 500, tol = 1e-12, ...) } \arguments{ \item{fun}{function whose root is sought.} \item{x}{a point near the root or an interval giving end points.} \item{maxiter}{maximum number of iterations.} \item{tol}{relative tolerance.} \item{...}{additional arguments to be passed to the function.} } \details{ \code{fzero} tries to find a zero of \code{f} near \code{x}, if \code{x} is a scalar. Expands the interval until different signs are found at the endpoints or the maximum number of iterations is exceeded. If \code{x} is a vector of length two, \code{fzero} assumes \code{x} is an interval where the sign of \code{x[1]} differs from the sign of \code{x[1]}. An error occurs if this is not the case. ``This is essentially the ACM algorithm 748. The structure of the algorithm has been transformed non-trivially: it implement here a FSM version using one interior point determination and one bracketing per iteration, thus reducing the number of temporary variables and simplifying the structure.'' This approach will not find zeroes of quadratic order. } \value{ \code{fzero} returns a list with \item{x}{location of the root.} \item{fval}{function value at the root.} } \references{ Alefeld, Potra and Shi (1995). Enclosing Zeros of Continuous Functions. ACM Transactions on Mathematical Software, Vol. 21, No. 3. } \note{ \code{fzero} mimics the Matlab function of the same name, but is translated from Octave's \code{fzero} function, copyrighted (c) 2009 by Jaroslav Hajek. } \seealso{ \code{\link{uniroot}}, \code{\link{brent}} } \examples{ fzero(sin, 3) # 3.141593 fzero(cos,c(1, 2)) # 1.570796 fzero(function(x) x^3-2*x-5, 2) # 2.094551 } \keyword{ math } pracma/man/deg2rad.Rd0000644000176200001440000000123111665436767014111 0ustar liggesusers\name{deg2rad} \alias{deg2rad} \alias{rad2deg} \title{Degrees to Radians} \description{ Transforms between angles in degrees and radians. } \usage{ deg2rad(deg) rad2deg(rad) } \arguments{ \item{deg}{(array of) angles in degrees.} \item{rad}{(array of) angles in radians.} } \details{ This is a simple calculation back and forth. Note that angles greater than 360 degrees are allowed and will be returned. This may appear incorrect but follows a corresponding discussion on Matlab Central. } \value{ The angle in degrees or radians. } \examples{ deg2rad(c(0, 10, 20, 30, 40, 50, 60, 70, 80, 90)) rad2deg(seq(-pi/2, pi/2, length = 19)) } \keyword{math} pracma/man/complexstep.Rd0000644000176200001440000000666712270767723015156 0ustar liggesusers\name{complexstep} \alias{complexstep} \alias{grad_csd} \alias{jacobian_csd} \alias{hessian_csd} \alias{laplacian_csd} \title{Complex Step Derivatives} \description{ Complex step derivatives of real-valued functions, including gradients, Jacobians, and Hessians. } \usage{ complexstep(f, x0, h = 1e-20, ...) grad_csd(f, x0, h = 1e-20, ...) jacobian_csd(f, x0, h = 1e-20, ...) hessian_csd(f, x0, h = 1e-20, ...) laplacian_csd(f, x0, h = 1e-20, ...) } \arguments{ \item{f}{Function that is to be differentiated.} \item{x0}{Point at which to differentiate the function.} \item{h}{Step size to be applied; shall be \emph{very} small.} \item{...}{Additional variables to be passed to \code{f}.} } \details{ Complex step derivation is a fast and highly exact way of numerically differentiating a function. If the following conditions are satisfied, there will be no loss of accuracy between computing a function value and computing the derivative at a certain point. \itemize{ \item \code{f} must have an analytical (i.e., complex differentiable) continuation into an open neighborhood of \code{x0}. \item \code{x0} \bold{and} \code{f(x0)} must be real. \item \code{h} is real and \emph{very} small: \code{0 < h << 1}. } \code{complexstep} handles differentiation of univariate functions, while \code{grad_csd} and \code{jacobian_csd} compute gradients and Jacobians by applying the complex step approach iteratively. Please understand that these functions are not vectorized, but \code{complexstep} is. As complex step cannot be applied twice (the first derivative does not fullfil the conditions), \code{hessian_csd} works differently. For the first derivation, complex step is used, to the one time derived function Richardson's method is applied. The same applies to \code{lapalacian_csd}. } \value{ \code{complexstep(f, x0)} returns the derivative \eqn{f'(x_0)} of \eqn{f} at \eqn{x_0}. The function is vectorized in \code{x0}. } \references{ Martins, J. R. R. A., P. Sturdza, and J. J. Alonso (2003). The Complex-step Derivative Approximation. ACM Transactions on Mathematical Software, Vol. 29, No. 3, pp. 245--262. } \author{ HwB } \note{ This surprising approach can be easily deduced from the complex-analytic Taylor formula. } \seealso{ \code{\link{numderiv}} } \examples{ ## Example from Martins et al. f <- function(x) exp(x)/sqrt(sin(x)^3 + cos(x)^3) # derivative at x0 = 1.5 # central diff formula # 4.05342789402801, error 1e-10 # numDeriv::grad(f, 1.5) # 4.05342789388197, error 1e-12 Richardson # pracma::numderiv # 4.05342789389868, error 5e-14 Richardson complexstep(f, 1.5) # 4.05342789389862, error 1e-15 # Symbolic calculation: # 4.05342789389862 jacobian_csd(f, 1.5) f1 <- function(x) sum(sin(x)) grad_csd(f1, rep(2*pi, 3)) ## [1] 1 1 1 laplacian_csd(f1, rep(pi/2, 3)) ## [1] -3 f2 <- function(x) c(sin(x[1]) * exp(-x[2])) hessian_csd(f2, c(0.1, 0.5, 0.9)) ## [,1] [,2] [,3] ## [1,] -0.06055203 -0.60350053 0 ## [2,] -0.60350053 0.06055203 0 ## [3,] 0.00000000 0.00000000 0 f3 <- function(u) { x <- u[1]; y <- u[2]; z <- u[3] matrix(c(exp(x^+y^2), sin(x+y), sin(x)*cos(y), x^2 - y^2), 2, 2) } jacobian_csd(f3, c(1,1,1)) ## [,1] [,2] [,3] ## [1,] 2.7182818 0.0000000 0 ## [2,] -0.4161468 -0.4161468 0 ## [3,] 0.2919266 -0.7080734 0 ## [4,] 2.0000000 -2.0000000 0 } \keyword{ math } pracma/man/meshgrid.Rd0000644000176200001440000000133511547665714014403 0ustar liggesusers\name{meshgrid} \alias{meshgrid} \title{ Generate a Mesh Grid } \description{ Generate two matrices for use in three-dimensional plots. } \usage{ meshgrid(x, y = x) } \arguments{ \item{x}{numerical vector, represents points along the x-axis.} \item{y}{numerical vector, represents points along the y-axis.} } \details{ The rows of the output array X are copies of the vector x; columns of the output array Y are copies of the vector y. } \value{ Returns two matrices as a list with \code{X} and \code{Y} components. } \note{ The three-dimensional variant \code{meshgrid(x, y, z)} is not yet implemented. } \seealso{ \code{\link{outer}} } \examples{ meshgrid(1:5)$X meshgrid(c(1, 2, 3), c(11, 12)) } \keyword{ array } pracma/man/wilkinson.Rd0000644000176200001440000000121112465405723014577 0ustar liggesusers\name{wilkinson} \alias{wilkinson} \title{wilkinson Matrix} \description{ Generate the Wilkinson matrix of size \code{n x n}.The Wilkinson matrix for testing eigenvalue computations } \usage{ wilkinson(n) } \arguments{ \item{n}{integer} } \details{ The Wilkinson matrix for testing eigenvalue computations is a symmetric matrix with three non-zero diagonals and with several pairs of nearly equal eigenvalues. } \value{ matrix of size \code{n x n} } \note{ The two largest eigenvalues of \code{wilkinson(21)} agree to 14, but not 15 decimal places. } \seealso{ \code{\link{Toeplitz}} } \examples{ (a <- wilkinson(7)) eig(a) } \keyword{ specmat } pracma/man/laplacian.Rd0000644000176200001440000000156312160543703014511 0ustar liggesusers\name{laplacian} \alias{laplacian} \title{ Laplacian Operator } \description{ Numerically compute the Laplacian of a function. } \usage{ laplacian(f, x0, h = .Machine$double.eps^(1/4), ...) } \arguments{ \item{f}{univariate function of several variables.} \item{x0}{point in \eqn{R^n}.} \item{h}{step size.} \item{...}{variables to be passed to \code{f}.} } \details{ Computes the Laplacian operator \eqn{f_{x_1 x_1} + \ldots + f_{x_n x_n}} based on the three-point central difference formula, expanded to this special case. Assumes that the function has continuous partial derivatives. } \value{ Real number. } \references{ Fausett, L. V. (2007). Applied Numerical Analysis Using Matlab. Second edition, Prentice Hall. } \seealso{ \code{\link{hessian}} } \examples{ f <- function(x) x[1]^2 + 2*x[1]*x[2] + x[2]^2 laplacian(f, c(1,1)) } \keyword{ math } pracma/man/polylog.Rd0000644000176200001440000000300512042212424014233 0ustar liggesusers\name{polylog} \alias{polylog} \title{ Polylogarithm Function } \description{ Computes the \code{n}-based polylogarithm of \code{z}: \code{Li_n(z)}. } \usage{ polylog(z, n) } \arguments{ \item{z}{real number or vector, all entries satisfying \code{abs(z)<1}.} \item{n}{base of polylogarithm, integer greater or equal -4.} } \details{ The Polylogarithm is also known as Jonquiere's function. It is defined as \deqn{\sum_{k=1}^{\infty}{z^k / k^n} = z + z^2/2^n + ...} The polylogarithm function arises, e.g., in Feynman diagram integrals. It also arises in the closed form of the integral of the Fermi-Dirac and the Bose-Einstein distributions. The special cases \code{n=2} and \code{n=3} are called the dilogarithm and trilogarithm, respectively. Approximation should be correct up to at least 5 digits for \eqn{|z| > 0.55} and on the order of 10 digits for \eqn{|z| <= 0.55}. } \value{ Returns the function value (not vectorized). } \note{ Based on some equations, see references. A Matlab implementation is available in the Matlab File Exchange. } \references{ V. Bhagat, et al. (2003). On the evaluation of generalized BoseEinstein and FermiDirac integrals. Computer Physics Communications, Vol. 155, p.7. } \examples{ polylog(0.5, 1) # polylog(z, 1) = -log(1-z) polylog(0.5, 2) # (p1^2 - 6*log(2)^2) / 12 polylog(0.5, 3) # (4*log(2)^3 - 2*pi^2*log(2) + 21*zeta(3)) / 24 polylog(0.5, 0) # polylog(z, 0) = z/(1-z) polylog(0.5, -1) # polylog(z, -1) = z/(1-z)^2 } \keyword{ math } pracma/man/squareform.Rd0000644000176200001440000000141112122054210014725 0ustar liggesusers\name{squareform} \alias{squareform} \title{ Format Distance Matrix (Matlab Style) } \description{ Format or generate a distance matrix. } \usage{ squareform(x) } \arguments{ \item{x}{numeric vector or matrix.} } \details{ If \code{x} is a vector as created by the \code{dist} function, it converts it into a fulll square, symmetric matrix. And if \code{x} is a distance matrix, i.e. square, symmetric amd with zero diagonal elements, it returns the flattened lower triangular submatrix. } \value{ Returns a matrix if \code{x} is a vector, and a vextor if \code{x} is a matrix. } \seealso{ \code{\link{dist}} } \examples{ x <- 1:6 y <- squareform(x) # 0 1 2 3 # 1 0 4 5 # 2 4 0 6 # 3 5 6 0 all(squareform(y) == x) # TRUE } \keyword{ array } pracma/man/nchoosek.Rd0000644000176200001440000000155511666144043014403 0ustar liggesusers\name{nchoosek} \alias{nchoosek} \title{ Binomial Coefficients } \description{ Compute the Binomial coefficients. } \usage{ nchoosek(n, k) } \arguments{ \item{n, k}{integers with \code{k} between 0 and \code{n}} } \details{ Alias for the corresponding R function \code{choose}. } \value{ integer, the Binomial coefficient \eqn{({n \over k})}. } \note{ In Matlab/Octave, if \code{n} is a vector all combinations of \code{k} elements from vector \code{n} will be generated. Here, use the function \code{combs} instead. } \seealso{ \code{\link{choose}} } \examples{ S <- sapply(0:6, function(k) nchoosek(6, k)) # 1 6 15 20 15 6 1 # Catalan numbers catalan <- function(n) choose(2*n, n)/(n+1) catalan(0:10) # 1 1 2 5 14 42 132 429 1430 4862 16796 # Relations n <- 10 sum((-1)^c(0:n) * sapply(0:n, function(k) nchoosek(n, k))) # 0 } \keyword{ arith } pracma/man/isposdef.Rd0000644000176200001440000000163313054015465014401 0ustar liggesusers\name{isposdef} \alias{isposdef} \title{ Positive Definiteness } \description{ Test for positive definiteness. } \usage{ isposdef(A, psd = FALSE, tol = 1e-10) } \arguments{ \item{A}{symmetric matrix} \item{psd}{logical, shall semi-positive definiteness be tested?} \item{tol}{tolerance to check symmetry and Cholesky decomposition.} } \details{ Whether matrix \code{A} is positive definite will be determined by applying the Cholesky decomposition. The matrix must be symmetric. With \code{psd=TRUE} the matrix will be tested for being semi-positive definite. If not positive definite, still a warning will be generated. } \value{ Returns \code{TRUE} or \code{FALSE}. } \examples{ A <- magic(5) # isposdef(A) ## [1] FALSE ## Warning message: ## In isposdef(A) : Matrix 'A' is not symmetric. ## FALSE A <- t(A) \%*\% A isposdef(A) ## [1] TRUE A[5, 5] <- 0 isposdef(A) ## [1] FALSE } \keyword{ array } pracma/man/einsteinF.Rd0000644000176200001440000000246311605542363014515 0ustar liggesusers\name{einsteinF} \alias{einsteinF} \title{ Einstein Functions } \description{ Einstein functions. } \usage{ einsteinF(d, x) } \arguments{ \item{x}{numeric or complex vector.} \item{d}{parameter to select one of the Einstein functions E1, E2, E3, E4.} } \details{ The Einstein functions are sometimes used for the Planck-Einstein oscillator in one degree of freedom. The functions are defined as: \deqn{E1(x) = \frac{x^2 e^x}{(e^x - 1)^2}} \deqn{E2(x) = \frac{x}{e^x - 1}} \deqn{E3(x) = ln(1 - e^{-x})} \deqn{E4(x) = \frac{x}{e^x - 1} - ln(1 - e^{-x})} \code{E1} has an inflection point as \code{x=2.34694130...}. } \value{ Numeric/complex scalar or vector. } \examples{ \dontrun{ x1 <- seq(-4, 4, length.out = 101) y1 <- einsteinF(1, x1) plot(x1, y1, type = "l", col = "red", xlab = "", ylab = "", main = "Einstein Function E1(x)") grid() y2 <- einsteinF(2, x1) plot(x1, y2, type = "l", col = "red", xlab = "", ylab = "", main = "Einstein Function E2(x)") grid() x3 <- seq(0, 5, length.out = 101) y3 <- einsteinF(3, x3) plot(x3, y3, type = "l", col = "red", xlab = "", ylab = "", main = "Einstein Function E3(x)") grid() y4 <- einsteinF(4, x3) plot(x3, y4, type = "l", col = "red", xlab = "", ylab = "", main = "Einstein Function E4(x)") grid()} } pracma/man/compan.Rd0000644000176200001440000000114313462656464014053 0ustar liggesusers\name{compan} \alias{compan} \title{Companion Matrix} \description{ Computes the companion matrix of a real or complex vector. } \usage{ compan(p) } \arguments{ \item{p}{vector representing a polynomial} } \details{ Computes the companion matrix corresponding to the vector \code{p} with \code{-p[2:length(p)]/p[1]} as first row. The eigenvalues of this matrix are the roots of the polynomial. } \value{ A square matrix of \code{length(p)-1} rows and columns } \seealso{ \code{\link{roots}} } \examples{ p <- c(1, 0, -7, 6) compan(p) # 0 7 -6 # 1 0 0 # 0 1 0 } \keyword{ array } pracma/man/figure.Rd0000644000176200001440000000156612042212424014041 0ustar liggesusers\name{figure} \alias{figure} \title{ Control Plot Devices (Matlab Style) } \description{ Open, activate, and close grahics devices. } \usage{ figure(figno, title = "") } \arguments{ \item{figno}{(single) number of plot device.} \item{title}{title of the plot device; not yet used.} } \details{ The number of a graphics device cannot be 0 or 1. The function will work for the operating systems Mac OS, MS Windows, and most Linux systems. If \code{figno} is negative and a graphics device with that number does exist, it will be closed. } \value{ No return value, except when a device of that number does not exist, in which case it returns a list of numbers of open graphics devices. } \note{ Does not bring the activated graphics device in front. } \seealso{ \code{dev.set, dev.off, dev.list} } \examples{ \dontrun{ figure() figure(-2) } } \keyword{ graphs } pracma/man/andor.Rd0000644000176200001440000000154212030655336013667 0ustar liggesusers\name{and, or} \alias{and} \alias{or} \title{ Logical AND, OR (Matlab Style) } \description{ \code{and(l, k)} resp. \code{or(l, k)} the same as \code{(l & k) + 0} resp. \code{(l | k) + 0}. } \usage{ and(l, k) or(l, k) } \arguments{ \item{l, k}{Arrays.} } \details{ Performs a logical operation of arrays \code{l} and \code{k} and returns an array containing elements set to either 1 (\code{TRUE}) or 0 (\code{FALSE}), that is in Matlab style. } \value{ Logical vector. } \examples{ A <- matrix(c(0.5, 0.5, 0, 0.75, 0, 0.5, 0, 0.75, 0.05, 0.85, 0.35, 0, 0, 0, 0.01, 0.5, 0.65, 0.65, 0.05, 0), 4, 5, byrow=TRUE) B <- matrix(c( 0, 1, 0, 1, 0, 1, 1, 1, 0, 1, 0, 1, 1, 1, 0, 0, 1, 0, 0, 1), 4, 5, byrow=TRUE) and(A, B) or(A, B) } \keyword{ logic } pracma/man/fibsearch.Rd0000644000176200001440000000201212042212424014471 0ustar liggesusers\name{fibsearch} \alias{fibsearch} \title{ Fibonacci Search } \description{ Fibonacci search for function minimum. } \usage{ fibsearch(f, a, b, ..., endp = FALSE, tol = .Machine$double.eps^(1/2)) } \arguments{ \item{f}{Function or its name as a string.} \item{a, b}{endpoints of the interval} \item{endp}{logical; shall the endpoints be considered as possible minima?} \item{tol}{absolute tolerance; default \code{eps^(1/2)}.} \item{...}{Additional arguments to be passed to f.} } \details{ Fibonacci search for a univariate function minimum in a bounded interval. } \value{ Return a list with components \code{xmin}, \code{fmin}, the function value at the minimum, \code{niter}, the number of iterations done, and the estimated precision \code{estim.prec} } \seealso{ \code{\link{uniroot}} } \examples{ f <- function(x) x * cos(0.1*exp(x)) * sin(0.1*pi*exp(x)) fibsearch(f, 0, 4, tol=10^-10) # $xmin = 3.24848329403424 optimize(f, c(0,4), tol=10^-10) # $minimum = 3.24848328971188 } \keyword{ optimize } pracma/man/broyden.Rd0000644000176200001440000000526513452637217014243 0ustar liggesusers\name{broyden} \alias{broyden} \title{Broyden's Method} \description{ Broyden's method for the numerical solution of nonlinear systems of \code{n} equations in \code{n} variables. } \usage{ broyden(Ffun, x0, J0 = NULL, ..., maxiter = 100, tol = .Machine$double.eps^(1/2)) } \arguments{ \item{Ffun}{\code{n} functions of \code{n} variables.} \item{x0}{Numeric vector of length \code{n}.} \item{J0}{Jacobian of the function at \code{x0}.} \item{...}{additional parameters passed to the function.} \item{maxiter}{Maximum number of iterations.} \item{tol}{Tolerance, relative accuracy.} } \details{ F as a function must return a vector of length \code{n}, and accept an \code{n}-dim. vector or column vector as input. F must not be univariate, that is \code{n} must be greater than 1. Broyden's method computes the Jacobian and its inverse only at the first iteration, and does a rank-one update thereafter, applying the so-called Sherman-Morrison formula that computes the inverse of the sum of an invertible matrix A and the dyadic product, uv', of a column vector u and a row vector v'. } \value{ List with components: \code{zero} the best root found so far, \code{fnorm} the square root of sum of squares of the values of f, and \code{niter} the number of iterations needed. } \references{ Quarteroni, A., R. Sacco, and F. Saleri (2007). Numerical Mathematics. Second Edition, Springer-Verlag, Berlin Heidelberg. } \note{ Applied to a system of \code{n} linear equations it will stop in \code{2n} steps } \seealso{ \code{\link{newtonsys}}, \code{\link{fsolve}} } \examples{ ## Example from Quarteroni & Saleri F1 <- function(x) c(x[1]^2 + x[2]^2 - 1, sin(pi*x[1]/2) + x[2]^3) broyden(F1, x0 = c(1, 1)) # zero: 0.4760958 -0.8793934; fnorm: 9.092626e-09; niter: 13 F <- function(x) { x1 <- x[1]; x2 <- x[2]; x3 <- x[3] as.matrix(c(x1^2 + x2^2 + x3^2 - 1, x1^2 + x3^2 - 0.25, x1^2 + x2^2 - 4*x3), ncol = 1) } x0 <- as.matrix(c(1, 1, 1)) broyden(F, x0) # zero: 0.4407629 0.8660254 0.2360680; fnorm: 1.34325e-08; niter: 8 ## Find the roots of the complex function sin(z)^2 + sqrt(z) - log(z) F2 <- function(x) { z <- x[1] + x[2]*1i fz <- sin(z)^2 + sqrt(z) - log(z) c(Re(fz), Im(fz)) } broyden(F2, c(1, 1)) # zero 0.2555197 0.8948303 , i.e. z0 = 0.2555 + 0.8948i # fnorm 7.284374e-10 # niter 13 ## Two more problematic examples F3 <- function(x) c(2*x[1] - x[2] - exp(-x[1]), -x[1] + 2*x[2] - exp(-x[2])) broyden(F3, c(0, 0)) # $zero 0.5671433 0.5671433 # x = exp(-x) F4 <- function(x) # Dennis Schnabel c(x[1]^2 + x[2]^2 - 2, exp(x[1] - 1) + x[2]^3 - 2) broyden(F4, c(2.0, 0.5), maxiter = 100) } \keyword{ math } pracma/man/newtonInterp.Rd0000644000176200001440000000166212042212424015251 0ustar liggesusers\name{newtonInterp} \alias{newtonInterp} \alias{lagrangeInterp} \title{ Lagrange and Newtons Interpolation } \description{ Lagrange's and Newton's method of polynomial interpolation. } \usage{ newtonInterp(x, y, xs = c()) lagrangeInterp(x, y, xs) } \arguments{ \item{x, y}{x-, y-coordinates of data points defining the polynomial.} \item{xs}{either empty, or a vector of points to be interpolated.} } \details{ Straightforward implementation of Lagrange's Newton's method (vectorized in \code{xs}). } \value{ A vector of values at \code{xs} of the polynomial defined by \code{x,y}. } \references{ Each textbook on numerical analysis. } \seealso{ \code{\link{neville}}, \code{\link{barylag}} } \examples{ p <- Poly(c(1, 2, 3)) fp <- function(x) polyval(p, x) x <- 0:4; y <- fp(x) xx <- linspace(0, 4, 51) yy <- lagrangeInterp(x, y, xx) yy <- newtonInterp(x, y, xx) \dontrun{ ezplot(fp, 0, 4) points(xx, yy)} } \keyword{ math } pracma/man/polypow.Rd0000644000176200001440000000116611566176665014317 0ustar liggesusers\name{polypow} \alias{polypow} \title{Polynomial Powers} \description{ Power of a polynomial. } \usage{ polypow(p, n) } \arguments{ \item{p}{vector representing a polynomial.} \item{n}{positive integer, the exponent.} } \details{ Uses \code{polymul} to multiply the polynomial \code{p} \code{n} times with itself. } \value{ Vector representing a polynomial. } \note{ There is no such function in Matlab or Octave. } \seealso{ \code{\link{polymul}} } \examples{ polypow(c(1, -1), 6) #=> (x - 1)^6 = (1 -6 15 -20 15 -6 1) polypow(c(1, 1, 1, 1, 1, 1), 2) # 1 2 3 4 5 6 5 4 3 2 1 } \keyword{ math } pracma/man/barylag.Rd0000644000176200001440000000306712042212424014177 0ustar liggesusers\name{barylag} \alias{barylag} \title{Barycentric Lagrange Interpolation} \description{ Barycentric Lagrange interpolation in one dimension. } \usage{ barylag(xi, yi, x) } \arguments{ \item{xi, yi}{x- and y-coordinates of supporting nodes.} \item{x}{x-coordinates of interpolation points.} } \details{ \code{barylag} interpolates the given data using the barycentric Lagrange interpolation formula (vectorized to remove all loops). } \value{ Values of interpolated data at points \code{x}. } \references{ Berrut, J.-P., and L. Nick Trefethen (2004). ``Barycentric Lagrange Interpolation''. SIAM Review, Vol. 46(3), pp.501--517. } \note{ Barycentric interpolation is preferred because of its numerical stability. } \seealso{ Lagrange or Newton interpolation. } \examples{ ## Generates an example with plot. # Input: # fun --- function that shall be 'approximated' # a, b --- interval [a, b] to be used for the example # n --- number of supporting nodes # m --- number of interpolation points # Output # plot of function, interpolation, and nodes # return value is NULL (invisible) \dontrun{ barycentricExample <- function(fun, a, b, n, m) { xi <- seq(a, b, len=n) yi <- fun(xi) x <- seq(a, b, len=m) y <- barylag(xi, yi, x) plot(xi, yi, col="red", xlab="x", ylab="y", main="Example of barycentric interpolation") lines(x, fun(x), col="yellow", lwd=2) lines(x, y, col="darkred") grid() } barycentricExample(sin, -pi, pi, 11, 101) # good interpolation barycentricExample(runge, -1, 1, 21, 101) # bad interpolation } } \keyword{ math } pracma/man/curvefit.Rd0000644000176200001440000000430612056721661014417 0ustar liggesusers\name{curvefit} \alias{curvefit} \title{ Parametric Curve Fit } \description{ Polynomial fitting of parametrized points on 2D curves, also requiring to meet some points exactly. } \usage{ curvefit(u, x, y, n, U = NULL, V = NULL) } \arguments{ \item{u}{the parameter vector.} \item{x, y}{x-, y-coordinates for each parameter value.} \item{n}{order of the polynomials, the same in x- and y-dirction.} \item{U}{parameter values where points will be fixed.} \item{V}{matrix with two columns and \code{lemgth(U)} rows; first column contains the x-, the second the y-values of those points kept fixed.} } \details{ This function will attempt to fit two polynomials to parametrized curve points using the linear least squares approach with linear equality constraints in \code{lsqlin}. The requirement to meet exactly some fixed points is interpreted as a linear equality constraint. } \value{ Returns a list with 4 components, \code{xp} and \code{yp} coordinates of the fitted points, and \code{px} and \code{py} the coefficients of the fitting polynomials in x- and y-direction. } \note{ In the same manner, derivatives/directions could be prescribed at certain points. } \seealso{ \code{\link{circlefit}}, \code{\link{lsqlin}} } \examples{ ## Approximating half circle arc with small perturbations N <- 50 u <- linspace(0, pi, N) x <- cos(u) + 0.05 * randn(1, N) y <- sin(u) + 0.05 * randn(1, N) n <- 8 cfit1 <- curvefit(u, x, y, n) \dontrun{ plot(x, y, col = "darkgray", pch = 19, asp = 1) xp <- cfit1$xp; yp <- cfit1$yp lines(xp, yp, col="blue") grid()} ## Fix the end points at t = 0 and t = pi U <- c(0, pi) V <- matrix(c(1, 0, -1, 0), 2, 2, byrow = TRUE) cfit2 <- curvefit(u, x, y, n, U, V) \dontrun{ xp <- cfit2$xp; yp <- cfit2$yp lines(xp, yp, col="red")} \dontrun{ ## Archimedian spiral n <- 8 u <- linspace(0, 3*pi, 50) a <- 1.0 x <- as.matrix(a*u*cos(u)) y <- as.matrix(a*u*sin(u)) plot(x, y, type = "p", pch = 19, col = "darkgray", asp = 1) lines(x, y, col = "darkgray", lwd = 3) cfit <- curvefit(u, x, y, n) px <- c(cfit$px); py <- c(cfit$py) v <- linspace(0, 3*pi, 200) xs <- polyval(px, v) ys <- polyval(py, v) lines(xs, ys, col = "navy") grid()} } \keyword{ fitting } pracma/man/golden_ratio.Rd0000644000176200001440000000204612042212424015220 0ustar liggesusers\name{golden_ratio} \alias{golden_ratio} \title{ Golden Ratio Search } \description{ Golden Ratio search for a univariate function minimum in a bounded interval. } \usage{ golden_ratio(f, a, b, ..., maxiter = 100, tol = .Machine$double.eps^0.5) } \arguments{ \item{f}{Function or its name as a string.} \item{a, b}{endpoints of the interval.} \item{maxiter}{maximum number of iterations.} \item{tol}{absolute tolerance; default \code{sqrt(eps)}.} \item{...}{Additional arguments to be passed to f.} } \details{ `Golden ratio' search for a univariate function minimum in a bounded interval. } \value{ Return a list with components \code{xmin}, \code{fmin}, the function value at the minimum, \code{niter}, the number of iterations done, and the estimated precision \code{estim.prec} } \seealso{ \code{\link{uniroot}} } \examples{ f <- function(x) x * cos(0.1*exp(x)) * sin(0.1*pi*exp(x)) golden_ratio(f, 0, 4, tol=10^-10) # $xmin = 3.24848329206212 optimize(f, c(0,4), tol=10^-10) # $minimum = 3.24848328971188 } \keyword{ optimize } pracma/man/cubicspline.Rd0000644000176200001440000000405112042212424015050 0ustar liggesusers\name{cubicspline} \alias{cubicspline} \title{ Interpolating Cubic Spline } \description{ Computes the natural interpolation cubic spline. } \usage{ cubicspline(x, y, xi = NULL, endp2nd = FALSE, der = c(0, 0)) } \arguments{ \item{x, y}{x- and y-coordinates of points to be interpolated.} \item{xi}{x-coordinates of points at which the interpolation is to be performed.} \item{endp2nd}{logical; if true, the derivatives at the endpoints are prescribed by \code{der}.} \item{der}{a two-components vector prescribing derivatives at endpoints.} } \details{ \code{cubicspline} computes the values at \code{xi} of the natural interpolating cubic spline that interpolate the values \code{y} at the nodes \code{x}. The derivatives at the endpoints can be prescribed. } \value{ Returns either the interpolated values at the points \code{xi} or, if \code{is.null(xi)}, the piecewise polynomial that represents the spline. } \note{ From the piecewise polynomial returned one can easily generate the spline function, see the examples. } \references{ Quarteroni, Q., and F. Saleri (2006). Scientific Computing with Matlab and Octave. Springer-Verlag Berlin Heidelberg. } \seealso{ \code{\link{spline}} } \examples{ ## Example: Average temperatures at different latitudes x <- seq(-55, 65, by = 10) y <- c(-3.25, -3.37, -3.35, -3.20, -3.12, -3.02, -3.02, -3.07, -3.17, -3.32, -3.30, -3.22, -3.10) xs <- seq(-60, 70, by = 1) # Generate a function for this pp <- cubicspline(x, y) ppfun <- function(xs) ppval(pp, xs) \dontrun{ # Plot with and without endpoint correction plot(x, y, col = "darkblue", xlim = c(-60, 70), ylim = c(-3.5, -2.8), xlab = "Latitude", ylab = "Temp. Difference", main = "Earth Temperatures per Latitude") lines(spline(x, y), col = "darkgray") grid() ys <- cubicspline(x, y, xs, endp2nd = TRUE) # der = 0 at endpoints lines(xs, ys, col = "red") ys <- cubicspline(x, y, xs) # no endpoint condition lines(xs, ys, col = "darkred") } } \keyword{ fitting } pracma/man/hessian.Rd0000644000176200001440000000177512160543703014224 0ustar liggesusers\name{hessian} \alias{hessian} \title{ Hessian Matrix } \description{ Numerically compute the Hessian matrix. } \usage{ hessian(f, x0, h = .Machine$double.eps^(1/4), ...) } \arguments{ \item{f}{univariate function of several variables.} \item{x0}{point in \eqn{R^n}.} \item{h}{step size.} \item{...}{variables to be passed to \code{f}.} } \details{ Computes the hessian matrix based on the three-point central difference formula, expanded to two variables. Assumes that the function has continuous partial derivatives. } \value{ An n-by-n matrix with \eqn{\frac{\partial^2 f}{\partial x_i \partial x_j}} as (i, j) entry. } \references{ Fausett, L. V. (2007). Applied Numerical Analysis Using Matlab. Second edition, Prentice Hall. } \seealso{ \code{\link{laplacian}} } \examples{ f <- function(x) cos(x[1] + x[2]) x0 <- c(0, 0) hessian(f, x0) f <- function(u) { x <- u[1]; y <- u[2]; z <- u[3] return(x^3 + y^2 + z^2 +12*x*y + 2*z) } x0 <- c(1,1,1) hessian(f, x0) } \keyword{ math } pracma/man/polyadd.Rd0000644000176200001440000000114611563500200014205 0ustar liggesusers\name{polyadd} \alias{polyadd} \title{Adding Polynomials} \description{ Add two polynomials given as vectors. } \usage{ polyadd(p, q) } \arguments{ \item{p, q}{Vectors representing two polynomials.} } \details{ Polynomial addition realized simply by multiplying and summing up all the coefficients after extending vectors to the same length. } \value{ Vector representing a polynomial. } \note{ There is no such function in Matlab or Octave. } \seealso{ \code{\link{conv}} } \examples{ polyadd(c(1, 1, 1), 1) polyadd(c(1, 1, 1), c(0, 0, 1)) polyadd(c(-0.5, 1, -1), c(0.5, 0, 1)) } \keyword{ math } pracma/man/sici.Rd0000644000176200001440000000272613340332672013520 0ustar liggesusers\name{Si, Ci} \alias{Si} \alias{Ci} \title{ Sine and Cosine Integral Functions } \description{ Computes the sine and cosine integrals through approximations. } \usage{ Si(x) Ci(x) } \arguments{ \item{x}{Scalar or vector of real numbers.} } \details{ The sine and cosine integrals are defined as \deqn{Si(x) = \int_0^x \frac{\sin(t)}{t} dt} \deqn{Ci(x) = - \int_x^\infty \frac{\cos(t)}{t} dt = \gamma + \log(x) + \int_0^x \frac{\cos(t)-1}{t} dt} where \eqn{\gamma} is the Euler-Mascheroni constant. } \value{ Returns a scalar of sine resp. cosine integrals applied to each element of the scalar/vector. The value \code{Ci(x)} is not correct, it should be \code{Ci(x)+pi*i}, only the real part is returned! The function is not truely vectorized, for vectors the values are calculated in a for-loop. The accuracy is about \code{10^-13} and better in a reasonable range of input values. } \references{ Zhang, S., and J. Jin (1996). Computation of Special Functions. Wiley-Interscience. } \seealso{ \code{\link{sinc}}, \code{\link{expint}} } \examples{ x <- c(-3:3) * pi Si(x); Ci(x) \dontrun{ xs <- linspace(0, 10*pi, 200) ysi <- Si(xs); yci <- Ci(xs) plot(c(0, 35), c(-1.5, 2.0), type = 'n', xlab = '', ylab = '', main = "Sine and cosine integral functions") lines(xs, ysi, col = "darkred", lwd = 2) lines(xs, yci, col = "darkblue", lwd = 2) lines(c(0, 10*pi), c(pi/2, pi/2), col = "gray") lines(xs, cos(xs), col = "gray") grid()} } \keyword{ specfun } pracma/man/ppfit.Rd0000644000176200001440000000332512042212424013675 0ustar liggesusers\name{ppfit} \alias{ppfit} \title{ Piecewise Polynomial Fit } \description{ Piecewise linear or cubic fitting. } \usage{ ppfit(x, y, xi, method = c("linear", "cubic")) } \arguments{ \item{x, y}{x-, y-coordinates of given points.} \item{xi}{x-coordinates of the choosen support nodes.} \item{method}{interpolation method, can be `constant', `linear', or `cubic' (i.e., `spline').} } \details{ \code{ppfit} fits a piece-wise polynomial to the input independent and dependent variables,\code{x} and \code{y}, respectively. A weighted linear least squares solution is provided. The weighting vector \code{w} must be of the same size as the input variables. } \value{ Returns a \code{pp} (i.e., piecewise polynomial) structure. } \note{ Following an idea of Copyright (c) 2012 Ben Abbott, Martin Helm for Octave. } \seealso{ \code{\link{mkpp}}, \code{\link{ppval}} } \examples{ x <- 0:39 y <- c( 8.8500, 32.0775, 74.7375, 107.6775, 132.0975, 156.6675, 169.0650, 187.5375, 202.2575, 198.0750, 225.9600, 204.3550, 233.8125, 204.5925, 232.3625, 204.7550, 220.1925, 199.5875, 197.3025, 175.3050, 218.6325, 163.0775, 170.6625, 148.2850, 154.5950, 135.4050, 138.8600, 125.6750, 118.8450, 99.2675, 129.1675, 91.1925, 89.7000, 76.8825, 83.6625, 74.1950, 73.9125, 55.8750, 59.8675, 48.1900) xi <- linspace(0, 39, 8) pplin <- ppfit(x, y, xi) # method = "linear" ppcub <- ppfit(x, y, xi, method = "cubic") \dontrun{ plot(x, y, type = "b", main = "Piecewise polynomial approximation") xs <- linspace(0, 39, 100) yslin <- ppval(pplin, xs) yscub <- ppval(ppcub, xs) lines(xs, yscub, col="red",lwd = 2) lines(xs, yslin, col="blue") grid()} } \keyword{ fitting } pracma/DESCRIPTION0000644000176200001440000000177214153577552013250 0ustar liggesusersPackage: pracma Type: Package Version: 2.3.6 Date: 2021-12-06 Title: Practical Numerical Math Functions Authors@R: person("Hans W.", "Borchers", email="hwborchers@googlemail.com", role=c("aut", "cre")) Depends: R (>= 3.1.0) Imports: graphics, grDevices, stats, utils Suggests: NlcOptim, quadprog Description: Provides a large number of functions from numerical analysis and linear algebra, numerical optimization, differential equations, time series, plus some well-known special mathematical functions. Uses 'MATLAB' function names where appropriate to simplify porting. License: GPL (>= 3) ByteCompile: true LazyData: yes Author: Hans W. Borchers [aut, cre] Maintainer: Hans W. Borchers Repository: CRAN Repository/R-Forge/Project: optimist Repository/R-Forge/Revision: 521 Repository/R-Forge/DateTimeStamp: 2021-12-06 09:26:46 Date/Publication: 2021-12-07 06:30:02 UTC NeedsCompilation: no Packaged: 2021-12-06 09:48:08 UTC; rforge pracma/tests/0000755000176200001440000000000014153356041012661 5ustar liggesuserspracma/tests/strings.R0000644000176200001440000000246512546667755014531 0ustar liggesusers## ## s t r i n g s . R tests ## strcat <- pracma::strcat strcmp <- pracma::strcmp strcmpi <- pracma::strcmpi strcmp(" empty", " empty") # T !strcmp("empty ", "empty") # F !strcmp("foobar", "barfoo") # F !strcmp("string", "String") # F !strcmp(c("yes", "no"), c("yes", "on")) # F !strcmp(c("abc", "abc"), c("abc")) # F strcmp(c("yes", "no"), c("yes", "no")) # T strcmpi("string", "String") # T strcmpi(c("yes", "no"), c("Yes", "No")) # T blanks <- pracma::blanks deblank <- pracma::deblank strTrim <- pracma::strTrim strjust <- pracma::strjust strRep <- pracma::strRep identical(c(blanks(0), blanks(1), blanks(2)), c("", " ", " ")) s <- c(" abc", "abc ", " abc ", " a b c ", "abc", "a b c") identical(deblank(s), c(" abc", "abc", " abc", " a b c", "abc", "a b c")) identical(strTrim(s), c("abc", "abc", "abc", "a b c", "abc", "a b c")) identical(strjust(s, justify = "center"), c(" abc ", " abc ", " abc ", "a b c", " abc ", "a b c")) s <- c('This is a good example.', "He has a good character.", 'This is good, good food.', "How goodgood this is!") identical(strRep(s, 'good', 'great'), c('This is a great example.', "He has a great character.", 'This is great, great food.', "How greatgreat this is!")) pracma/tests/factors.R0000755000176200001440000000174612031005021014436 0ustar liggesusers### ### f a c t o r s . R +++ Test suite +++ ### test.factors <- function(input, expected) { output <- do.call(getFromNamespace("factors", "pracma"), input) identical(output, expected) } factors.expected.n2 <- 2 factors.expected.n3 <- 3 # factors.expected.prm <- 999983 # factors.expected.pr2 <- c(9999889, 9999901) # factors.expected.prp <- c(65003, 65003) # factors.expected.nn <- c(2, 2, 2, 2, 2, 3, 3, 3, 3, 5, 5, 5, 7, 7, 11) # factors.expected.nm <- c(99989, 99991, 100003) # factors.expected.n32 <- c(3, 5, 17, 257, 65537) test.factors(list(n=2), factors.expected.n2) test.factors(list(n=3), factors.expected.n3) # test.factors(list(n=999983), factors.expected.prm) # test.factors(list(n=9999889*9999901), factors.expected.pr2) # test.factors(list(n=4225390009), factors.expected.prp) # test.factors(list(n=2^5 * 3^4 * 5^3 * 7^2 * 11), factors.expected.nn) # test.factors(list(n=99989*99991*100003), factors.expected.nm) # test.factors(list(n=2^32-1), factors.expected.n32) pracma/tests/conv.R0000644000176200001440000000057311563500200013744 0ustar liggesusers## ## c o n v . r Test suite ## conv <- pracma::conv deconv <- pracma::deconv all.equal(conv(c(1, 1, 1), 1), c(1, 1, 1)) all.equal(conv(c(1, 1, 1), c(0, 0, 1)), c(0, 0, 1, 1, 1)) all.equal(conv(c(-0.5, 1, -1), c(0.5, 0, 1)), c(-0.25, 0.5, -1, 1, -1)) b <- c(-0.25, 0.5, -1, 1, -1) a <- c(0.5, 0, 1) d <- deconv(b, a) all.equal(d$q, c(-0.5, 1, -1)) all.equal(d$r, c(0, 0)) pracma/tests/polyfit.R0000755000176200001440000000153611540452742014504 0ustar liggesusers### ### polyfit.R +++ Test suite +++ ### test.polyfit <- function(input, expected) { output <- do.call(getFromNamespace("polyfit", "pracma"), input) identical(all.equal(output, expected, tolerance=1e-7), TRUE ) } polyfit.expected.n1 <- c(1, 0) polyfit.expected.n23 <- c(0, 1, 1, 1) polyfit.expected.n4 <- c(-1, 0, 7, 0, 0) / 6 polyfit.expected.mat <- c(0, 1, -14, 65, -112, 60) / 12 test.polyfit(list(x=c(1,2,3), y=c(1,2,3)), polyfit.expected.n1) test.polyfit(list(x=c(-2,-1,0,1,2), y=c(3,1,1,3,7), n=3), polyfit.expected.n23) test.polyfit(list(x=c(-2,-1,0,1,2), y=c(2,1,0,1,2), n=4), polyfit.expected.n4) test.polyfit(list(x=matrix(1:6, nrow=2, ncol=3, byrow=TRUE), y=matrix(c(0,0,1,1,0,0), nrow=2, ncol=3, byrow=TRUE), n=5), polyfit.expected.mat) pracma/tests/deval.R0000644000176200001440000000145011567677214014115 0ustar liggesusers## ## d e v a l . R Test suite ## deval <- pracma::deval deeve <- pracma::deeve x <- seq(0, 10*pi, len=100) y <- zapsmall(sin(x)) all.equal(deval(x, y, c(-1e-5, 0, 1, 5, 10, 15, 20, 25, 30, x[100], 40)), as.matrix(c( NA, 0.0000000, 0.8358028, -0.9499175, -0.5372202, 0.6442378, 0.9117673, -0.1307134, -0.9756776, 0.0000000, NA)), tolerance = 1e-5 ) all.equal(deeve(x, y), c(0.000000, 3.141206, 6.282671, 9.424329, 12.566114, 15.707963, 18.849812, 21.991597, 25.133255, 28.274720, 31.415927), tolerance = 1e-5) pracma/tests/quadrature.R0000644000176200001440000001500012172306455015160 0ustar liggesusers## ## q u a d r a t u r e . R Test suite ## quad <- pracma::quad quadl <- pracma::quadl quadgk <- pracma::quadgk quadgr <- pracma::quadgr quadinf <- pracma::quadinf quad2d <- pracma::quad2d dblquad <- pracma::dblquad simpson2d <- pracma::simpson2d simpadpt <- pracma::simpadpt gauss_kronrod <- pracma::gauss_kronrod clenshaw_curtis <- pracma::clenshaw_curtis romberg <- pracma::romberg gaussLegendre <- pracma::gaussLegendre gaussHermite <- pracma::gaussHermite gaussLaguerre <- pracma::gaussLaguerre ## F i n i t e I n t e r v a l s f1 <- function(x) exp(x)*sin(x) # [0, pi] 12.0703463163896 = 1/2*(1+e^pi) f2 <- pracma::runge # [-1, 1] 0.549360306778006 f3 <- function(x) 1/(x^3 - 2*x - 5) # [0, 2] -0.460501533846733 f4 <- function(x) abs(sin(10*x)) # [0, pi] 2.0 # quad (Adaptive Simpson) all.equal(quad(f1, 0, pi, tol=1e-12), 12.0703463163896, tolerance = 1e-12) all.equal(quad(f2, -1, 1, tol=1e-12), 0.549360306778006, tolerance = 1e-12) all.equal(quad(f3, 0, 2, tol=1e-12), -0.460501533846733, tolerance = 1e-12) all.equal(quad(f4, 0, pi, tol=1e-12), 2.0, tolerance = 1e-12) # quadl (Adaptive Lobatto) all.equal(quadl(f1, 0, pi, tol=1e-9), 12.0703463163896, tolerance = 1e-12) all.equal(quadl(f2, -1, 1, tol=1e-9), 0.549360306778006, tolerance = 1e-12) all.equal(quadl(f3, 0, 2, tol=1e-9), -0.460501533846733, tolerance = 1e-12) all.equal(quadl(f4, 0, pi, tol=1e-12), 2.0, tolerance = 1e-12) # quadgr (Gauss-Richardson) all.equal(quadgr(f1, 0, pi, tol=1e-12)$value, 12.0703463163896, tolerance = 1e-13) all.equal(quadgr(f2, -1, 1, tol=1e-12)$value, 0.549360306778006, tolerance = 1e-15) all.equal(quadgr(f3, 0, 2, tol=1e-12)$value, -0.460501533846733, tolerance = 1e-15) all.equal(quadgr(f4, 0, pi, tol=1e-12)$value, 2.0, tolerance = 1e-15) # quadgk (Adaptive Gauss-Kronrod) all.equal(quadgk(f1, 0, pi), 12.0703463163896, tolerance = 1e-13) all.equal(quadgk(f2, -1, 1), 0.549360306778006, tolerance = 1e-15) all.equal(quadgk(f3, 0, 2), -0.460501533846733, tolerance = 1e-13) all.equal(quadgk(f4, 0, pi, tol = 1e-12), 2.0, tolerance = 1e-12) # Adaptive Simpson (simpadpt) all.equal(simpadpt(f1, 0, pi, tol=1e-12), 12.0703463163896, tolerance = 1e-13) all.equal(simpadpt(f2, -1, 1, tol=1e-12), 0.549360306778006, tolerance = 1e-12) all.equal(simpadpt(f3, 0, 2, tol=1e-12), -0.460501533846733, tolerance = 1e-13) all.equal(simpadpt(f4, 0, pi, tol=1e-12), 2.0, tolerance = 1e-14) # Gauss-Kronrod all.equal(gauss_kronrod(f1, 0, pi)$value, 12.0703463163896, tolerance = 1e-13) all.equal(gauss_kronrod(f2, -1, 1)$value, 0.549360306778006, # BAD tolerance = 1e-2) all.equal(gauss_kronrod(f3, 0, 2)$value, -0.460501533846733, # Bad tolerance = 1e-5) all.equal(gauss_kronrod(f4, 0, pi)$value, 2.0, # BAD tolerance = 1e-0) # Clenshaw-Curtis all.equal(clenshaw_curtis(f1, 0, pi, n = 128), 12.0703463163896, tolerance = 1e-12) all.equal(clenshaw_curtis(f2, -1, 1, n = 128), 0.549360306778006, tolerance = 1e-12) all.equal(clenshaw_curtis(f3, 0, 2, n = 128), -0.460501533846733, tolerance = 1e-12) all.equal(clenshaw_curtis(f4, 0, pi, n = 1024), 2.0, # Bad tolerance = 2e-5) # romberg all.equal(romberg(f1, 0, pi, tol=1e-12)$value, 12.0703463163896, tolerance = 1e-12) all.equal(romberg(f2, -1, 1, tol=1e-12)$value, 0.549360306778006, tolerance = 1e-12) all.equal(romberg(f3, 0, 2, tol=1e-12)$value, -0.460501533846733, # BAD tolerance = 1e-3) all.equal(romberg(f4, 0, pi, tol=1e-12)$value, 2.0, tolerance = 1e-12) f5 <- function(x) log(x)*sin(x)/x # pi/2 * gamma , cannot be computed ! f6 <- function(x) sin(x)^2 * exp(-x) # [0, Inf] , 0.4 f7 <- function(x) sin(x)^2 * exp(-x^2) # [-Inf, Inf] , (e-1)*sqrt(pi)/(4*e) x7 <- (exp(1)-1) * sqrt(pi) / (2*exp(1)) # quadinf all.equal(quadinf(f6, 0, Inf), 0.4, tolerance = 1e-15) all.equal(quadinf(f7, -Inf, Inf), x7, tolerance = 1e-15) all.equal(quadgr(f6, 0, Inf)$value, 0.4, tolerance = 1e-11) all.equal(quadgr(f7, -Inf, Inf)$value, x7, tolerance = 1e-9) gL <- gaussLaguerre(64) all.equal(sum(gL$w * sin(gL$x)^2), 0.4, tolerance = 1e-15) gH <- gaussHermite(64) all.equal(sum(gH$w * sin(gH$x)^2), x7, tolerance = 1e-14) f8 <- function(x, y) y * sin(x) # [0, pi/2]x[0, 1] , 1/2 f9 <- function(x, y) ifelse(x^2 + y^2 <= 1, 1-x^2-y^2, 0) # quad2d all.equal(quad2d(f8, 0, pi/2, 0, 1), 0.5, tolerance = 1e-15) all.equal(quad2d(f9, -1, 1, 0, 1, n = 128), pi/4, tolerance = 1e-6) # dblquad all.equal(dblquad(f8, 0, pi/2, 0, 1), 0.5, tolerance = 1e-15) #all.equal(dblquad(f9, -1, 1, 0, 1), pi/4, tolerance = 1e-6) # disabled because of problems with Fedora and Solaris # simpson2d all.equal(simpson2d(f8, 0, pi/2, 0, 1), 0.5, tolerance = 1e-9) all.equal(simpson2d(f9, -1, 1, 0, 1), pi/4, tolerance = 1e-5) # Integrals with singularities at boundaries: f11 <- function(t) log(1-t) / t # [1, 0] pi^2/6 , dilogarithm f12 <- function(t) log(-log(t)) # [0, 1] gamma = 0.57721 56649 01532 ... f13 <- function(t) 1 / sqrt(t) # [0, 1] 2.0 all.equal(quad(f11, 1, 0, tol = 1e-12), 1.64493406684823, tolerance = 1e-10) all.equal(quad(f12, 0, 1, tol = 1e-12), -0.577215664901533, tolerance = 5e-10) all.equal(quad(f13, 0, 1, tol = 1e-12), 2.0, tolerance = 1e-4) # Bad all.equal(quadl(f11, 1, 0, tol = 1e-12), 1.64493406684823, tolerance = 1e-12) all.equal(quadl(f12, 0, 1, tol = 1e-12), -0.577215664901533, tolerance = 5e-12) all.equal(quadl(f13, 0, 1, tol = 1e-12), 2.0, tolerance = 1e-7) # Bad all.equal(quadgr(f11, 1, 0, tol = 1e-12)$value, 1.64493406684823, tolerance = 1e-12) all.equal(quadgr(f12, 0, 1, tol = 1e-12)$value, -0.577215664901533, tolerance = 5e-12) all.equal(quadgr(f13, 0, 1, tol = 1e-12)$value, 2.0, tolerance = 1e-12) all.equal(simpadpt(f11, 1, 0, tol = 1e-12), 1.64493406684823, tolerance = 1e-11) all.equal(simpadpt(f12, 0, 1, tol = 1e-12), -0.577215664901533, tolerance = 5e-11) all.equal(simpadpt(f13, 0, 1, tol = 1e-10), 2.0, tolerance = 1e-7) # Bad ## E o F pracma/tests/polyval.R0000755000176200001440000000115111540452742014475 0ustar liggesusers### ### polyval.R +++ Test suite +++ ### test.polyval <- function(input, expected) { output <- do.call(getFromNamespace("polyval", "pracma"), input) identical(output, expected) } polyval.expected.empty1 <- c() polyval.expected.empty2 <- c(0, 0) polyval.expected.vec <- c(3, 1, 1, 3, 7) polyval.expected.mat <- matrix(c(1, 4, 9, 16), nrow=2, ncol=2) test.polyval(list(p=c(1,1), x=c()), polyval.expected.empty1) test.polyval(list(p=c(), x=c(1,1)), polyval.expected.empty2) test.polyval(list(p=c(1,1,1), x=-2:2), polyval.expected.vec) test.polyval(list(p=c(1,0,0), x=matrix(1:4, 2, 2)), polyval.expected.mat) pracma/tests/ceil.R0000644000176200001440000000045712031004636013717 0ustar liggesusers## ## c e i l . R tests ## ceil <- pracma::ceil Fix <- pracma::Fix identical(ceil(0), 0) identical(ceil(-1), -1) identical(ceil(-1.5), -1) identical(ceil(1), 1) identical(ceil(1.5), 2) identical(Fix(0), 0) identical(Fix(-1), -1) identical(Fix(-1.5), -1) identical(Fix(1), 1) identical(Fix(1.5), 1) pracma/tests/regexp.R0000644000176200001440000000174311546151101014274 0ustar liggesusers## ## r e g e x p . R Test suite ## regexp <- pracma::regexp regexpi <- pracma::regexpi regexprep <- pracma::regexprep refindall <- pracma::refindall s <- "bat cat can car COAT court cut ct CAT-scan" pat <- 'c[aeiou]+t' identical(regexp(s, pat)$match, c("cat", "cut")) identical(regexpi(s, pat)$match, c("cat", "COAT", "cut", "CAT")) identical(regexp(s, pat, once = TRUE)$match, c("cat")) identical(regexp(s, pat, ignorecase = TRUE, split = TRUE)$split, c("bat ", " can car ", " court ", " ct ", "-scan")) identical(regexprep(s, pat, '---'), c("bat --- can car COAT court --- ct CAT-scan")) identical(regexprep(s, pat, '---', once = TRUE), c("bat --- can car COAT court cut ct CAT-scan")) identical(regexprep(s, pat, '---', ignorecase = TRUE), c("bat --- can car --- court --- ct ----scan")) identical(refindall("AbababaBa", 'aba'), c(3, 5)) identical(refindall("AbababaBa", 'aba', ignorecase = TRUE), c(1, 3, 5, 7)) pracma/tests/hilb.R0000755000176200001440000000104011540452742013722 0ustar liggesusers### ### hilb.R +++ Test suite +++ ### test.hilb <- function(input, expected) { output <- do.call(getFromNamespace("hilb", "pracma"), input) identical(output, expected) } hilb.expected.m1 <- matrix(NA, nrow=0, ncol=0) hilb.expected.0 <- matrix(0, nrow=0, ncol=0) hilb.expected.1 <- matrix(1, nrow=1, ncol=1) hilb.expected.5 <- 1 / matrix(c(1:5,2:6,3:7,4:8,5:9), nrow=5,ncol=5) test.hilb(list(n=-1), hilb.expected.m1) test.hilb(list(n=0), hilb.expected.0) test.hilb(list(n=1), hilb.expected.1) test.hilb(list(n=5), hilb.expected.5) pracma/tests/roots.R0000755000176200001440000000136511540452742014164 0ustar liggesusers### ### roots.R +++ Test suite +++ ### test.roots <- function(input, expected) { output <- do.call(getFromNamespace("roots", "pracma"), input) identical(output, expected) } roots.expected.empty <- matrix(0, nrow=0, ncol=0) roots.expected.singl <- matrix(0, nrow=0, ncol=0) roots.expected.bspl1 <- c(0, 2, -2, 1, -1) # Matlab: c(0, -2, -1, 1, 2) c(0, 2, -2, 1, -1) roots.expected.bspl2 <- c(0.5, -0.2) roots.expected.bspl3 <- -c(0, 0, -1, 1) test.roots(list(p=c()), roots.expected.empty) test.roots(list(p=c(0)), roots.expected.singl) #test.roots(list(p=c(1,0,-5,0,4,0)), roots.expected.bspl1) # zapsmall test.roots(list(p=c(1,-0.3,-0.1)), roots.expected.bspl2) test.roots(list(p=c(1,0,-1,0,0)), roots.expected.bspl3) pracma/tests/linspace.R0000644000176200001440000000072111543131761014602 0ustar liggesusers## ## l i n s p a c e . R ## linspace <- pracma::linspace logspace <- pracma::logspace logseq <- pracma::logseq identical(linspace(1, 100), as.numeric(1:100)) identical(linspace(0, 25, 5), c(0, 6.25, 12.50, 18.75, 25)) identical(linspace(1, 25, 1.5), 25) identical(all.equal(logspace(1, pi, n=5), c(10.0000, 7.4866, 5.6050, 4.1963, 3.1416), tolerance=0.0001), TRUE) all.equal(logseq(1, 100, 3), c(1, 10, 100)) pracma/tests/pchip.R0000644000176200001440000000066511562173556014127 0ustar liggesusers## ## p c h i p . R Test suite ## pchip <- pracma::pchip x <- c(1, 2, 3, 4, 5, 6) y <- c(16, 18, 21, 17, 15, 12) xs <- c(1.5, 2.5, 3.5, 4.5, 5.5) ys <- pchip(x, y, xs) # ys <- interp1(x, y, xs, method="cubic") # the same # 16.88750 19.80000 19.33333 15.96667 13.63750 yml <- c(16.887499999999999, 19.800000000000001, 19.333333333333332, 15.966666666666667, 13.637499999999999) all.equal(ys, yml, tolerance = 1e-7) pracma/tests/flipdim.R0000644000176200001440000000100411540452742014425 0ustar liggesusers## ## f l i p d i m . R tests ## flipdim <- pracma::flipdim flipud <- pracma::flipud fliplr <- pracma::fliplr rot90 <- pracma::rot90 a <- matrix(c(1,2,3, 4,5,6, 7,8,9, 10,11,12), nrow=3, ncol=4) b <- matrix(c(1,2, 3,4), nrow=2, ncol=2, byrow=TRUE) identical(flipdim(a, 1), flipud(a)) identical(fliplr(a), matrix(c(10,11,12, 7,8,9, 4,5,6, 1,2,3 ), 3, 4)) identical(rot90(b, k=1), matrix(c(2,1, 4,3), 2, 2)) identical(rot90(b, k=6), matrix(c(4,2, 3,1), 2, 2)) identical(rot90(b, k=-1), matrix(c(3,4, 1,2), 2, 2)) pracma/tests/trapz.R0000755000176200001440000000125111540452742014150 0ustar liggesusers### ### trapz.R +++ Test suite +++ ### test.trapz <- function(input, expected) { output <- do.call(getFromNamespace("trapz", "pracma"), input) identical(output, expected) } trapz.expected.empty1 <- 0 trapz.expected.empty2 <- 0 trapz.expected.gen1 <- 12 trapz.expected.gen2 <- 6 trapz.expected.cmpl1 <- 0+0.5i trapz.expected.cmpl2 <- 0+0.5i test.trapz(list(x=c()), trapz.expected.empty1) test.trapz(list(x=c(), y=c()), trapz.expected.empty2) test.trapz(list(x=1:5), trapz.expected.gen1) test.trapz(list(x=seq(0,2,by=0.5), y=1:5), trapz.expected.gen2) test.trapz(list(x=c(0,1), y=c(0,1i)), trapz.expected.cmpl1) test.trapz(list(x=c(0,1i), y=c(0,1)), trapz.expected.cmpl2) pracma/tests/polyadd.R0000644000176200001440000000054111563500200014426 0ustar liggesusers## ## p o l y m u l . R Test suite ## polyadd <- pracma::polyadd identical(polyadd(c(1, 1, 1), 1), c(1, 1, 2)) identical(polyadd(c(1, 1, 1), c(0, 1)), c(1, 1, 2)) identical(polyadd(c(0.5, 1, 1), c(0.5, 1, -1)), c(1, 2, 0)) identical(polyadd(c(0.5, 1, 1), c(-0.5, -1, 1)), c(2)) identical(polyadd(c(0, 0, 1, 2, 2), c(0, 1, 2, 3, 4)), c(1, 3, 5, 6)) pracma/tests/perms.R0000644000176200001440000000037711540452742014143 0ustar liggesusers## ## p e r m s . R Test Suite ## perms <- pracma::perms randperm <- pracma::randperm identical(perms(2), matrix(2, 1, 1)) identical(perms(c(1, 2)), matrix(c(2, 1, 1, 2), 2, 2)) identical(nrow(perms(1:6)), 720L) all(c(1,2,3) %in% randperm(c(1,2,3))) pracma/tests/interp1.R0000644000176200001440000000100311545666512014371 0ustar liggesusers## ## i n t e r p 1 . R Test suite ## interp1 <- pracma::interp1 x <- c(0.0, 0.5, 1.0, 1.5) y <- x^2 xi <- c(0.25, 0.75, 1.25) identical(interp1(x, y, xi, method="constant"), c(0.0, 0.25, 1.0)) identical(interp1(x, y, xi, method="linear"), c(0.125, 0.625, 1.625)) identical(interp1(x, y, xi, method="nearest"), c(0.25, 1.00, 2.25)) identical(interp1(x, y, xi, method="spline"), c(0.0625, 0.5625, 1.5625)) # Not yet implemented # identical(interp1(x, y, xi, method="cubic"), c(0.0781, 0.5547, 1.5547)) pracma/tests/compan.R0000755000176200001440000000113411540452742014265 0ustar liggesusers### ### compan.R +++ Test suite +++ ### test.compan <- function(input, expected) { output <- do.call(getFromNamespace("compan", "pracma"), input) identical(output, expected) } compan.expected.empty <- c() compan.expected.sngl1 <- c() compan.expected.sngl2 <- c() compan.expected.bspl1 <- matrix(c(0, 7, -6, 1, 0, 0, 0, 1, 0), nrow=3, ncol=3, byrow=TRUE) test.compan(list(p=c()), compan.expected.empty) test.compan(list(p=c(0)), compan.expected.sngl1) test.compan(list(p=c(1)), compan.expected.sngl2) test.compan(list(p=c(1,0,-7,6)), compan.expected.bspl1) pracma/tests/combs.R0000644000176200001440000000041311540452742014107 0ustar liggesusers## ## c o m b s . R Test Suite ## combs <- pracma::combs randcomb <- pracma::randcomb identical(combs(2, 1), 2) identical(combs(c(1, 2, 3), 2), matrix(rep(c(1, 2, 3), each = 2), 3, 2)) identical(nrow(combs(1:6, 4)), 15L) all(c(1,2,3) %in% randcomb(c(1,2,3), 3)) pracma/tests/chebyshev.R0000644000176200001440000000162711552371733014777 0ustar liggesusers## ## c h e b P o l y . R Test suite ## chebPoly <- pracma::chebPoly chebCoeff <- pracma::chebCoeff chebApprox <- pracma::chebApprox identical(chebPoly(6), matrix( c(0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 2, 0, -1, 0, 0, 0, 4, 0, -3, 0, 0, 0, 8, 0, -8, 0, 1, 0, 16, 0, -20, 0, 5, 0, 32, 0, -48, 0, 18, 0, -1), nrow = 7, ncol = 7, byrow=TRUE)) f <- function(x) 1 + x/1 + x^2/2 + x^3/6 + x^4/24 + x^5/120 + x^6/720 cC <- chebCoeff(f, -1, 1, 6) cC[1] <- cC[1]/2 all.equal(cC, c(1.26606, 1.13021, 0.27148, 0.04427, 0.00547, 0.00052, 0.00004), tol = 1e-5) x <- seq(-1, 1, length.out=7) y <- chebApprox(x, function(x) x^2, -1, 1, 6) all.equal(x^2, y, tol = 1e-7) pracma/tests/inv.R0000755000176200001440000000076311540452742013613 0ustar liggesusers### ### eig.R +++ Test suite +++ ### test.inv <- function(input, expected) { output <- do.call(getFromNamespace("inv", "pracma"), input) identical(output, expected) } inv.expected.empty <- matrix(0, nrow=0, ncol=0) inv.expected.singl <- matrix(Inf, 2, 2) inv.expected.mat1 <- matrix(c(3,-3,1, -3,5,-2, 1,-2,1), 3, 3) test.inv(list(a=c()), inv.expected.empty) test.inv(list(a=matrix(1, 2, 2)), inv.expected.singl) test.inv(list(a=matrix(c(1,1,1, 1,2,3, 1,3,6), 3, 3)), inv.expected.mat1) pracma/tests/isprime.R0000755000176200001440000000162311540452742014463 0ustar liggesusers### ### ISPRIME.R +++ Test suite +++ ### test.isprime <- function(input, expected) { output <- do.call(getFromNamespace("isprime", "pracma"), input) identical(output, expected) } isprime.expected.n1 <- 0 isprime.expected.n2 <- 1 isprime.expected.n100 <- matrix(c(0, 1, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0 ), nrow=10, ncol=10, byrow=TRUE) test.isprime(list(x=1), isprime.expected.n1) test.isprime(list(x=2), isprime.expected.n2) test.isprime(list(x=matrix(1:100, 10, 10, byrow=TRUE)), isprime.expected.n100) pracma/tests/piecewise.R0000644000176200001440000000050411543131761014760 0ustar liggesusers## ## p i e c e w i s e . R Test suite ## piecewise <- pracma::piecewise x <- c(0, 1, 2, 3, 4, 5) y <- c(1, 1, -1, 0, 1, 0) identical(piecewise(x, y)$area, 1.5) identical(piecewise(x, y)$zeros, c(1.5, 3, 5)) identical(piecewise(x, y, abs = TRUE)$area, 3.0) identical(piecewise(x, y, abs = TRUE)$zeros, c(1.5, 3, 5)) pracma/tests/polyder.R0000755000176200001440000000115311540452742014467 0ustar liggesusers### ### polyder.R +++ Test suite +++ ### test.polyder <- function(input, expected) { output <- do.call(getFromNamespace("polyder", "pracma"), input) identical(output, expected) } polyder.expected.0 <- 0 polyder.expected.1 <- 0 polyder.expected.5 <- c(4, 3, 2, 1) polyder.expected.3 <- c(2, 0) polyder.expected.2 <- c(12, 36, 42, 18) test.polyder(list(p=c()), polyder.expected.0) test.polyder(list(p=c(1)), polyder.expected.1) test.polyder(list(p=c(1,1,1,1,1)), polyder.expected.5) test.polyder(list(p=c(1,0,0), q=c(0,0,1)), polyder.expected.3) test.polyder(list(p=c(3,6,9), q=c(1,2,0)), polyder.expected.2) pracma/tests/cond.R0000644000176200001440000000057711562043262013737 0ustar liggesusers## ## c o n d . r Test suite ## cond <- pracma::cond normest <- pracma::normest hilb <- pracma::hilb all.equal(c(cond(hilb(1)), cond(hilb(2)), cond(hilb(3)), cond(hilb(4))), c(1, 19.281470, 524.056778, 15513.738739), tolerance = 1e-6) magic <- pracma::magic all.equal(normest(magic(5)), max(svd(magic(5))$d)) all.equal(normest(pracma::magic(100)), 500050) pracma/tests/polyarea.R0000755000176200001440000000150711540452742014630 0ustar liggesusers### ### polyarea.R +++ Test suite +++ ### test.polyarea <- function(input, expected) { output <- do.call(getFromNamespace("polyarea", "pracma"), input) identical(output, expected) } polyarea.expected.empty <- 0 polyarea.expected.gen1 <- 3.5 polyarea.expected.gen2 <- 4 polyarea.expected.mtrx <- c(4, 4) polyarea.expected.cmpl <- 0.5 test.polyarea(list(x=c(), y=c()), polyarea.expected.empty) test.polyarea(list(x=c(0,2,2,1,0), y=c(0,-1,2,1,1)), polyarea.expected.gen1) test.polyarea(list(x=matrix(c(1,1,3,3,1), 5, 1), y=matrix(c(1,3,3,1,1), 5, 1)), polyarea.expected.gen2) test.polyarea(list(x=matrix(c(1,3,3,1,1,1,3,3), 4, 2), y=matrix(c(1,1,3,3,1,3,3,1), 4, 2)), polyarea.expected.mtrx) test.polyarea(list(x=c(0,1,1,0), y=c(0,0,1i,0)), polyarea.expected.cmpl) pracma/tests/subspace.R0000644000176200001440000000066512030655336014621 0ustar liggesusers## ## s u b s p a c e . r Test suite ## orth <- pracma::orth subspace <- pracma::subspace is.null(orth(c())) M <- matrix(1:12, 3, 4) all.equal(orth(M), matrix(c(-0.504533, -0.760776, -0.574516, -0.057141, -0.644497, 0.646495), 3, 2, byrow = TRUE), tolerance = 1e-5) H <- pracma::hadamard(8) A <- H[, 2:4] B <- H[, 5:8] all.equal(subspace(A, B), pi/2, tolerance = 1e-10) pracma/tests/polymul.R0000644000176200001440000000044711556762673014532 0ustar liggesusers## ## p o l y m u l . R Test suite ## polymul <- pracma::polymul identical(polymul(c(0.5), c(2, 4, 8)), c(1, 2, 4)) identical(polymul(c(2.5, 1.5, 0.5), c(2)), c(5, 3, 1)) identical(polymul(c(1, 1, 1), c(0, 1, 1, 1)), c(1, 2, 3, 2, 1)) identical(polymul(c(1, 0, 0), c(0, 0, 1)), c(1, 0, 0)) pracma/tests/size.R0000644000176200001440000000120711540452742013760 0ustar liggesusers## ## s i z e . R tests ## size <- pracma::size numel <- pracma::numel ndims <- pracma::ndims isempty <- pracma::isempty identical(size(1:8), c(1, 8)) identical(size(1:8, 1), 1) identical(size(1:8, 2), 8) identical(size(1:8, 3), 1) identical(size(matrix(1:12, 3, 4)), c(3L, 4L)) identical(numel(array(0, c(4,4,2))), 32) identical(numel(1:100), 100) identical(ndims(array(NA, c(4,4,2))), 3L) identical(ndims(list(a=1:5)), 2L) identical(isempty(numeric(0)), TRUE) identical(isempty(matrix(0, 1, 0)), TRUE) identical(isempty(matrix(0, 1, 1)), FALSE) identical(isempty(array(NA, c(2,2,2))), FALSE) identical(isempty(array(NA, c(2,0,2))), TRUE) pracma/tests/eig.R0000755000176200001440000000116011540452742013553 0ustar liggesusers### ### eig.R +++ Test suite +++ ### test.eig <- function(input, expected) { output <- do.call(getFromNamespace("eig", "pracma"), input) identical(output, expected) } eig.expected.empty <- matrix(0, nrow=0, ncol=0) eig.expected.singl <- 1 eig.expected.mat1 <- c(2, 0) eig.expected.mat2 <- c(1+1i, 1-1i) eig.expected.mat3 <- c(1, -1) test.eig(list(a=c()), eig.expected.empty) test.eig(list(a=c(1)), eig.expected.singl) test.eig(list(a=matrix(c(1,-1,-1,1), 2, 2)), eig.expected.mat1) test.eig(list(a=matrix(c(1,1,-1,1), 2, 2)), eig.expected.mat2) test.eig(list(a=matrix(c(0,1i,-1i,0), 2, 2)), eig.expected.mat3) pracma/tests/rectint.R0000644000176200001440000000062212210406370014445 0ustar liggesusers## ## r e c t i n t . R Tests ## rectint <- pracma::rectint x <- matrix(c(0, 0, 1, 1), ncol = 4) y <- matrix(c( 0.75,-0.25, 0.5, 0.5, 0.75, 0.25, 0.5, 0.5, 0.75, 0.25, 0.2, 0.5, 0.75, 0.75, 0.5, 0.5, 0.75,-0.25, 0.5, 1.5), ncol = 4, byrow = TRUE) all.equal(rectint(x, y), matrix(c(0.0625, 0.125, 0.1, 0.0625, 0.25), nrow = 1)) pracma/tests/mod.R0000644000176200001440000000064412030335456013566 0ustar liggesusers## ## m o d . R tests ## mod <- pracma::mod rem <- pracma::rem identical(mod(0, 0), 0) identical(mod(1, 0), 1) identical(mod(0, 2), 0) identical(mod(5, 3), 2) identical(mod(5, -3), -1) identical(mod(-5, 3), 1) identical(mod(-5, -3), -2) identical(rem(0, 0), NaN) identical(rem(1, 0), NaN) identical(rem(0, 2), 0) identical(rem(5, 3), 2) identical(rem(5, -3), 2) identical(rem(-5, 3), -2) identical(rem(-5, -3), -2) pracma/tests/pascal.R0000644000176200001440000000063211540452742014252 0ustar liggesusers## ## p a s c a l . R Test Suite ## pascal <- pracma::pascal nchoosek <- pracma::nchoosek identical(pascal(3), matrix(c(1, 1, 1, 1, 2, 3, 1, 3, 6), 3, 3)) identical(nchoosek(6, 1), choose(6, 1)) identical(nchoosek(6, 2), choose(6, 2)) identical(nchoosek(6, 3), choose(6, 3)) identical(nchoosek(6, 4), choose(6, 4)) identical(nchoosek(6, 5), choose(6, 5)) identical(nchoosek(6, 6), choose(6, 6)) pracma/tests/magic.R0000644000176200001440000000310711547665714014103 0ustar liggesusers## ## ma g i c . R -- Test suite ## magic <- pracma::magic identical(magic(3), matrix(c(8, 1, 6, 3, 5, 7, 4, 9, 2), nrow = 3, ncol = 3, byrow = TRUE)) identical(magic(4), matrix(c(16, 2, 3, 13, 5, 11, 10, 8, 9, 7, 6, 12, 4, 14, 15, 1), nrow = 4, ncol = 4, byrow = TRUE)) identical(magic(6), matrix(c(35, 1, 6, 26, 19, 24, 3, 32, 7, 21, 23, 25, 31, 9, 2, 22, 27, 20, 8, 28, 33, 17, 10, 15, 30, 5, 34, 12, 14, 16, 4, 36, 29, 13, 18, 11), nrow = 6, ncol = 6, byrow = TRUE)) identical(magic(10), matrix(c(92, 99, 1, 8, 15, 67, 74, 51, 58, 40, 98, 80, 7, 14, 16, 73, 55, 57, 64, 41, 4, 81, 88, 20, 22, 54, 56, 63, 70, 47, 85, 87, 19, 21, 3, 60, 62, 69, 71, 28, 86, 93, 25, 2, 9, 61, 68, 75, 52, 34, 17, 24, 76, 83, 90, 42, 49, 26, 33, 65, 23, 5, 82, 89, 91, 48, 30, 32, 39, 66, 79, 6, 13, 95, 97, 29, 31, 38, 45, 72, 10, 12, 94, 96, 78, 35, 37, 44, 46, 53, 11, 18,100, 77, 84, 36, 43, 50, 27, 59), nrow = 10, ncol = 10, byrow = TRUE)) pracma/tests/primes.R0000755000176200001440000000136711540452742014317 0ustar liggesusers### ### PRIMES.R +++ Test suite +++ ### test.primes <- function(input, expected) { output <- do.call(getFromNamespace("primes", "pracma"), input) identical(output, expected) } primes.expected.n1 <- NULL primes.expected.n2 <- 2 primes.expected.n3 <- c(2, 3) primes.expected.n5 <- c(2, 3, 5) primes.expected.n8 <- c(2, 3, 5, 7) primes.expected.101 <- c( 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97,101) test.primes(list(n=1), primes.expected.n1) test.primes(list(n=2), primes.expected.n2) test.primes(list(n=3), primes.expected.n3) test.primes(list(n=5), primes.expected.n5) test.primes(list(n=8), primes.expected.n8) test.primes(list(n=101), primes.expected.101) pracma/tests/pow2.R0000755000176200001440000000111511540452742013676 0ustar liggesusers### ### pow2.R +++ Test suite +++ ### test.pow2 <- function(input, expected) { output <- do.call(getFromNamespace("pow2", "pracma"), input) identical(output, expected) } pow2.expected.00 <- 0 pow2.expected.m1 <- -0.5 pow2.expected.f <- c(1, 2, 4, 8) pow2.expected.fe <- c(0, 0.5, -8, 24) pow2.expected.c <- c(2^(1i), 2^(-1i)) test.pow2(list(f=0, e=0), pow2.expected.00) test.pow2(list(f=-1, e=-1), pow2.expected.m1) test.pow2(list(f=c(0,1,2,3)), pow2.expected.f) test.pow2(list(f=c(0,1,-2,3), e=c(0,-1,2,3)), pow2.expected.fe) test.pow2(list(f=c(1i, -1i)), pow2.expected.c) pracma/tests/fnorm.R0000644000176200001440000000032611547665714014144 0ustar liggesusers## ## f n o r m Test suite ## fnorm <- pracma::fnorm identical(fnorm(log, sqrt, 1, 2, p = Inf), 1.0) identical(fnorm(log, sqrt, 1, 2, p = -Inf), sqrt(2) - log(2)) identical(fnorm(log, sqrt, 1, 2, p = 0), Inf) pracma/tests/meshgrid.R0000644000176200001440000000040011547665714014616 0ustar liggesusers## ## m e s h g r i d . R Test suite ## meshgrid <- pracma::meshgrid identical(meshgrid(1:3, 10:14)$X, matrix(rep(c(1:3), each = 5), nr = 5, nc = 3)) identical(meshgrid(1:3, 10:14)$Y, matrix(rep(10:14, times = 3), nr = 5, nc = 3)) pracma/tests/diag.R0000644000176200001440000000031112001517660013677 0ustar liggesusers## ## m t r a c e . R Test suite ## Diag <- pracma::Diag all.equal(Diag(matrix(1:12,3,4), 1), c(4,8,12)) all.equal(Diag(matrix(1:12,3,4), -1), c(2,6)) identical(Diag(Diag(c(1,5,9)), 0), c(1,5,9)) pracma/tests/blkdiag.R0000644000176200001440000000050312001565513014373 0ustar liggesusers## ## r e p m a t . R Test Suite ## repmat <- pracma::repmat Reshape <- pracma::Reshape v <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12) a <- matrix(v, 3, 4) identical(Reshape(a, 4, 3), matrix(v, 4, 3)) identical(repmat(matrix(1:4, 2, 2), 3), matrix(rep(c(rep(c(1,2), 3), rep(c(3, 4), 3)), 3), nrow=6, ncol=6)) pracma/tests/rank.R0000644000176200001440000000067212037612645013750 0ustar liggesusers## ## r a n k . r Test suite ## Rank <- pracma::Rank nullspace <- pracma::nullspace magic <- pracma::magic all.equal(Rank(c()), 0) r <- numeric(8) for (i in 3:10){ r[i-2] <- Rank(magic(i)) } identical(r, c(3, 3, 5, 5, 7, 3, 9, 7)) hilb <- pracma::hilb identical(Rank(hilb(6)), 6L) # Vorzeichenwechsel moeglich # N <- nullspace(magic(4)) # all.equal(as.numeric(N), c(0.2236, 0.6708, -0.6708, -0.2236), # tolerance = 1e-5) pracma/tests/nextpow2.R0000755000176200001440000000164711540452742014607 0ustar liggesusers### ### nextpow2.R +++ Test suite +++ ### test.nextpow2 <- function(input, expected) { output <- do.call(getFromNamespace("nextpow2", "pracma"), input) identical(output, expected) } nextpow2.expected.empty <- NULL nextpow2.expected.0 <- 0 nextpow2.expected.vector <- c(0, 1, 2, 2, 3, 3, 3, 3, 4, 4) nextpow2.expected.matrix <- matrix(c(0, 1, 1, 0), 2, 2) nextpow2.expected.16 <- 4 nextpow2.expected.m16 <- 4 nextpow2.expected.m6 <- -19 nextpow2.expected.mq <- -2 test.nextpow2(list(x=c()), nextpow2.expected.empty) test.nextpow2(list(x=0), nextpow2.expected.0) test.nextpow2(list(x=1:10), nextpow2.expected.vector) test.nextpow2(list(x=matrix(c(1i, 2i, 2+0i, 0+0i), 2, 2)), nextpow2.expected.matrix) test.nextpow2(list(x=16), nextpow2.expected.16) test.nextpow2(list(x=-16), nextpow2.expected.m16) test.nextpow2(list(x=1e-6), nextpow2.expected.m6) test.nextpow2(list(x=-0.25), nextpow2.expected.mq) pracma/tests/findintervals.R0000644000176200001440000000034511567677214015674 0ustar liggesusers## ## f i n d i n t e r v a l s . R Test suite ## findintervals <- pracma::findintervals identical(findintervals(0, zapsmall(sin(seq(0, 10*pi, len=100)))), as.integer(c(1, 10, 20, 30, 40, 50, 60, 70, 80, 90, 100))) pracma/tests/poly.R0000755000176200001440000000134212001565513013766 0ustar liggesusers### ### Poly.R +++ Test suite +++ ### test.Poly <- function(input, expected) { output <- do.call(getFromNamespace("Poly", "pracma"), input) identical(output, expected) } Poly.expected.empty <- 1 Poly.expected.1 <- c(1, -6, 11, -6) #Poly.expected.2 <- error Poly.expected.3 <- c(1, 0, 0, 0, -1) Poly.expected.4 <- c(1, -10, 35, -50, 24) Poly.expected.5 <- c(1, -4, 6, -4, 1) Poly.expected.6 <- c(1, -5) test.Poly(list(x=c()), Poly.expected.empty) test.Poly(list(x=c(1,2,3)), Poly.expected.1) #test.Poly(list(x=matrix(1:6, 2, 3)), Poly.expected.2) test.Poly(list(x=c(1,-1,1i,-1i)), Poly.expected.3) test.Poly(list(x=c(1,2,3,4)), Poly.expected.4) test.Poly(list(x=diag(4)), Poly.expected.5) test.Poly(list(x=5), Poly.expected.6) pracma/tests/gradient.R0000644000176200001440000000142711572466165014620 0ustar liggesusers## ## g r a d i e n t . R Test suite ## gradient <- pracma::gradient x <- c(0.0, 0.2, 0.4, 0.6, 0.8, 1.0) y <- c(1, 2, 3) Z <- matrix(c( 1, 1.04, 1.16, 1.36, 1.64, 2, 4, 4.04, 4.16, 4.36, 4.64, 5, 9, 9.04, 9.16, 9.36, 9.64, 10), nrow = 3, byrow = TRUE) X1 <- matrix(c( 0.04, 0.08, 0.16, 0.24, 0.32, 0.36, 0.04, 0.08, 0.16, 0.24, 0.32, 0.36, 0.04, 0.08, 0.16, 0.24, 0.32, 0.36), nrow = 3, byrow = TRUE) X2 <- matrix(c( 0.2, 0.4, 0.8, 1.2, 1.6, 1.8, 0.2, 0.4, 0.8, 1.2, 1.6, 1.8, 0.2, 0.4, 0.8, 1.2, 1.6, 1.8), nrow = 3, byrow = TRUE) Y <- matrix(c( 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5), nrow = 3, byrow = TRUE) all.equal(gradient(Z)$X, X1) all.equal(gradient(Z, x, y)$X, X2) all.equal(gradient(Z, x, y)$Y, Y) pracma/tests/gamma.R0000644000176200001440000000100611710050147014055 0ustar liggesusers## ## g a m m a z . R Test suite ## gammaz <- pracma::gammaz ## Problematic on Solaris (2012-01-25) # y <- seq(from=0,to=5,by=0.5) # # z0 <- lngamma_complex(1+y*1i) # z0 <- c(0.0000000+0.0000000i, -0.1909455-0.2440583i, -0.6509232-0.3016403i, # -1.2344831-0.1629398i, -1.8760788+0.1296463i, -2.5499068+0.5426044i, # -3.2441443+1.0533508i, -3.9524671+1.6461926i, -4.6710996+2.3096981i, # -5.3976062+3.0351970i, -6.1303241-2.4672867i) # # all.equal(gammaz(1+y*1i), exp(z0), tolerance = 1e-7) pracma/tests/vander.R0000755000176200001440000000216611540452742014275 0ustar liggesusers### ### VANDER.R +++ Test suite +++ ### test.vander <- function(input, expected) { output <- do.call(getFromNamespace("vander", "pracma"), input) identical(output, expected) } vander.expected.empty <- matrix(as.numeric(NA), nrow=0, ncol=0) vander.expected.scalar <- matrix(1.0, nrow=1, ncol=1) vander.expected.seq3 <- matrix(c( 1, 1, 1, 1, 1, 5.0625, 3.375, 2.25, 1.5, 1, 16, 8, 4, 2, 1, 39.0625, 15.625, 6.25, 2.5, 1, 81, 27, 9, 3, 1), nrow=5, ncol=5, byrow=TRUE) vander.expected.complex <- matrix(c(-1, 0.0 + 1i, 1.0, -4, 0.0 + 2i, 1.0, -9, 0.0 + 3i, 1.0), nrow=3, ncol=3, byrow=TRUE) test.vander(list(x=numeric()), vander.expected.empty) test.vander(list(x=1), vander.expected.scalar) test.vander(list(x=seq(from=1, to=3, by=0.5)), vander.expected.seq3) test.vander(list(x=c(1,2,3)*1i), vander.expected.complex) pracma/tests/polyint.R0000755000176200001440000000060011540452742014503 0ustar liggesusers### ### polyint.R +++ Test suite +++ ### test.polyint <- function(input, expected) { output <- do.call(getFromNamespace("polyint", "pracma"), input) identical(output, expected) } polyint.expected.1 <- c(1, 0) polyint.expected.2 <- c(1/6, 1/5, 1/4, 1/3, 1/2, 1, 1) test.polyint(list(p=c(1)), polyint.expected.1) test.polyint(list(p=c(1,1,1,1,1,1), k=1), polyint.expected.2) pracma/tests/distmat.R0000644000176200001440000000056211540452742014456 0ustar liggesusers## ## d i s t m a t . R tests ## distmat <- pracma::distmat A <- c(0.0, 0.0, 0.0) B <- matrix(c( 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1), nrow = 8, ncol = 3, byrow = TRUE) all.equal(drop(distmat(A, B)), c(0, 1, 1, 1, sqrt(2), sqrt(2), sqrt(2), sqrt(3))) pracma/tests/trace.R0000644000176200001440000000026212001517521014072 0ustar liggesusers## ## m t r a c e . R Test suite ## Trace <- pracma::Trace identical(Trace(1), 1) identical(Trace(matrix(c(1,2,3,4,5,6,7,8,9), 3, 3)), 15) # Error: Trace(matrix(1:12, 3, 4)) pracma/tests/quad.R0000644000176200001440000000030311550053063013726 0ustar liggesusers## ## q u a d . R Test suite ## quad <- pracma::quad all.equal(quad(sin, 0, pi), 2, tol = 1e-7) all.equal(quad(sin, 0, 2*pi), 0, tol = 1e-7) all.equal(quad(exp, 0, 1), exp(1) - 1, tol=1e-7) pracma/tests/hankel.R0000644000176200001440000000052312030655336014247 0ustar liggesusers## ## hankel.R Test ## hankel <- pracma::hankel identical(hankel(2), matrix(2, nrow=1, ncol=1)) identical(hankel(1:3), matrix(c(1,2,3,2,3,0,3,0,0), 3, 3)) identical(hankel(1:3, 3:1), matrix(c(1,2,3,2,3,2,3,2,1), 3, 3)) identical(hankel(1:3, 2:1), matrix(c(1,2,3,2,3,1), 3, 2)) identical(hankel(1:2, 3:1), matrix(c(1,2,2,2,2,1), 2, 3)) pracma/tests/find.R0000644000176200001440000000052412001565513013721 0ustar liggesusers## ## f i n d . R tests ## finds <- pracma::finds v <- c(3, 2, 1, 1, 2, 3) identical(finds(v == 1), c(3L, 4L)) v <- c(1, 0, 4, -3, 0, 0, 0, 8, 6) identical(finds(v), as.integer(c(1, 3, 4, 8, 9))) identical(finds(v > 2), c(3L, 8L, 9L)) identical(finds(c()), integer(0)) identical(finds(c(TRUE, FALSE, TRUE, FALSE, TRUE)), c(1L, 3L, 5L)) pracma/tests/interp2.R0000644000176200001440000000163111572466165014403 0ustar liggesusers## ## i n t e r p 2 . R Test suite ## interp2 <- pracma::interp2 x <- c(0.0, 0.2, 0.4, 0.6, 0.8, 1.0) y <- c(1, 2, 3) Z <- matrix(c( 1, 1.04, 1.16, 1.36, 1.64, 2, 4, 4.04, 4.16, 4.36, 4.64, 5, 9, 9.04, 9.16, 9.36, 9.64, 10), nrow = 3, byrow = TRUE) all.equal(interp2(x, y, Z, 0.55, 2.55, method = "constant"), 4.16) all.equal(interp2(x, y, Z, 0.55, 2.55, method = "nearest"), 9.36) all.equal(interp2(x, y, Z, 0.5, 2.5, method = "linear"), 6.76) all.equal(interp2(x, y, Z, 0.55, 2.5, method = "linear"), 6.81) all.equal(interp2(x, y, Z, 0.5, 2.55, method = "linear"), 7.01) all.equal(interp2(x, y, Z, 0.55, 2.55, method = "linear"), 7.06) all.equal(interp2(x, y, Z, 0.0, 1.5, method = "linear"), 2.5) all.equal(interp2(x, y, Z, 0.1, 1.0, method = "linear"), 1.02) all.equal(interp2(x, y, Z, 1.0, 2.5, method = "linear"), 7.5) all.equal(interp2(x, y, Z, 0.9, 3.0, method = "linear"), 9.82) pracma/tests/nthroot.R0000755000176200001440000000106011540452742014503 0ustar liggesusers### ### NTHROOT.R +++ Test suite +++ ### test.nthroot <- function(input, expected) { output <- do.call(getFromNamespace("nthroot", "pracma"), input) identical(output, expected) } nthroot.expected.n0 <- c(-1.2) nthroot.expected.n1 <- c(1, -2, 3) nthroot.expected.n2 <- c(1, 0, 3) nthroot.expected.n3 <- c(1, -2, 3) test.nthroot(list(x=-1.2^5, n=5), nthroot.expected.n0) test.nthroot(list(x=c(1,-2, 3), n=1), nthroot.expected.n1) test.nthroot(list(x=c(1, 0, 9), n=2), nthroot.expected.n2) test.nthroot(list(x=c(1,-8,27), n=3), nthroot.expected.n3) pracma/tests/norm.R0000644000176200001440000000043712030661542013760 0ustar liggesusers## ## n o r m Test suite ## Norm <- pracma::Norm identical(Norm(c(3, 4)), 5) identical(Norm(c(1, 1, 1), p=2), sqrt(3)) identical(Norm(1:10, p = 1), sum(1:10)+0.0) identical(Norm(1:10, p = 0), Inf) identical(Norm(1:10, p = Inf), max(1:10)) identical(Norm(1:10, p = -Inf), min(1:10)) pracma/tests/horner.R0000644000176200001440000000046211553266213014305 0ustar liggesusers## ## h or n e r . R Test Suite ## horner <- pracma::horner hornerdefl <- pracma::hornerdefl p <- c(1, 0, 1) x <- c(-2, -1, 0, 1, 2) identical(horner(p, x)$y, x^2 + 1) identical(horner(p, x)$dy, 2*x) p <- c(1, -6, 11, -6) identical(hornerdefl(p, 3)$y, 0) identical(hornerdefl(p, 3)$q, (c(1, -3, 2))) pracma/tests/mldivide.R0000644000176200001440000000050111542066276014604 0ustar liggesusers## ## m l d i v i d e . R test suite ## mldivide <- pracma::mldivide mrdivide <- pracma::mrdivide A <- matrix(c(8,1,6, 3,5,7, 4,9,2), nrow = 3, ncol = 3, byrow = TRUE) identical(all.equal(mldivide(A, A), diag(1, 3, 3), tolerance=1e-7), TRUE) identical(all.equal(mrdivide(A, A), diag(1, 3, 3), tolerance=1e-7), TRUE) pracma/tests/mode.R0000644000176200001440000000026712001565513013731 0ustar liggesusers## ## m o d e . R ## Mode <- pracma::Mode x <- c(1:100, rep(5,3), rep(27,5), rep(71,4), rep(89,2), rep(100, 5)) identical(Mode(x), 27) x <- as.factor(x) identical(Mode(x), "27") pracma/tests/wilkinson.R0000755000176200001440000000033412030655336015025 0ustar liggesusers### ### wilkinson.R +++ Test suite +++ ### wilkinson <- pracma::wilkinson identical(wilkinson(0), NULL) identical(wilkinson(1), matrix(0, nrow=1, ncol=1)) identical(wilkinson(3), matrix(c(1,1,0, 1,0,1, 0,1,1), 3, 3)) pracma/tests/findpeaks.R0000644000176200001440000000107511543125177014757 0ustar liggesusers## ## f i n d p e a k s . R Test suite ## findpeaks <- pracma::findpeaks x <- c(2, 12, 4, 6, 9, 4, 3, 1, 19, 7) identical(findpeaks(x), matrix(c(12,9,19, 2,5,9, 1,3,8, 3,8,10), nrow=3, ncol=4)) identical(findpeaks(x, npeaks = 1, sortstr = TRUE), matrix(c(19, 9, 8, 10), nrow = 1)) identical(findpeaks(x, minpeakheight = 15), matrix(c(19, 9, 8, 10), nrow = 1)) identical(findpeaks(x, threshold = 10), matrix(c(19, 9, 8, 10), nrow = 1)) # Not yet implemented # identical(findpeaks(x, threshold = 10), # c(19, 9, 8, 9)) pracma/tests/crossn.R0000644000176200001440000000031411540452742014313 0ustar liggesusers## ## c r o s s n . R tests ## crossn <- pracma::crossn x <- c(1.0, 0.0, 0.0) y <- c(1.0, 0.5, 0.0) z <- c(0.0, 0.0, 1.0) identical(pracma::dot(x, crossn(rbind(y, z))), det(rbind(x, y, z))) pracma/tests/lambertW.R0000644000176200001440000000065711562173556014602 0ustar liggesusers## ## l a m b e r t W . R test suite ## lambertWp <- pracma::lambertWp x <- seq(0, 10, len=21) # y <- lambert_W0(x) y0 <- c(0.0000000, 0.3517337, 0.5671433, 0.7258614, 0.8526055, 0.9585864, 1.0499089, 1.1302893, 1.2021679, 1.2672378, 1.3267247, 1.3815454, 1.4324048, 1.4798568, 1.5243452, 1.5662310, 1.6058120, 1.6433371, 1.6790164, 1.7130288, 1.7455280) all.equal(lambertWp(x), y0, tolerance = 1e-7) pracma/tests/dot.R0000755000176200001440000000124411540452742013600 0ustar liggesusers### ### dot.R +++ Test suite +++ ### test.dot <- function(input, expected) { output <- do.call(getFromNamespace("dot", "pracma"), input) identical(output, expected) } dot.expected.empty <- 0 dot.expected.55 <- 55 dot.expected.t55 <- 55 dot.expected.mm <- c(26, 44) dot.expected.00 <- 0 dot.expected.neg <- -2 test.dot(list(x=c(), y=c()), dot.expected.empty) test.dot(list(x=1:5, y=1:5), dot.expected.55) test.dot(list(x=1:5, y=t(t(1:5))), dot.expected.t55) test.dot(list(x=matrix(c(1,3,2,4), 2, 2), y=matrix(c(5,7,6,8), 2, 2)), dot.expected.mm) test.dot(list(x=c(0, 0), y=c(1, 2)), dot.expected.00) test.dot(list(x=c(1, 1), y=c(-1, -1)), dot.expected.neg) pracma/tests/strfind.R0000644000176200001440000000077411542722330014462 0ustar liggesusers## ## s t r f i n d . R Test suite ## strfind <- pracma::strfind strfindi <- pracma::strfindi #findstr <- pracma::findstr identical(strfind("", "aba"), NULL) identical(strfind("ab", "aba"), NULL) identical(strfind("aba", "aba"), 1) identical(strfind("ababa", "aba"), c(1, 3)) identical(strfind("ababa", "aba", overlap=FALSE), 1) identical(strfindi("ABA", "aba"), 1) identical(strfindi("aba", "ABA"), 1) identical(strfindi("ABABA", "aba"), c(1, 3)) identical(strfindi("aBaBa", "AbA", overlap=FALSE), 1) pracma/tests/hadamard.R0000644000176200001440000000134512030655336014551 0ustar liggesusers## ## ha d a m a r d . R Test suite ## hadamard <- pracma::hadamard Toeplitz <- pracma::Toeplitz all.equal(hadamard(2), matrix(c(1, 1, 1, -1), 2, 2)) all.equal(hadamard(4), matrix(c(1, 1, 1, 1, 1, -1, 1, -1, 1, 1, -1, -1, 1, -1, -1, 1), 4, 4)) # H12 <- hadamard(12) # all.equal(t(H12) %*% H12, # diag(12, 12, 12)) # H20 <- hadamard(20) # all.equal(t(H20) %*% H20, # diag(20, 20, 20)) all.equal(Toeplitz(c(1, 2, 4, 6, 8), c(1, 3, 5, 7, 9)), matrix(c(1, 3, 5, 7, 9, 2, 1, 3, 5, 7, 4, 2, 1, 3, 5, 6, 4, 2, 1, 3, 8, 6, 4, 2, 1), 5, 5, byrow = TRUE)) pracma/tests/std.R0000644000176200001440000000043711566455115013611 0ustar liggesusers## ## s t d . r tests ## std <- pracma::std std_err <- pracma::std_err all.equal(std(1:10), 3.0277, tolerance=0.0001) all.equal(std(1:10, flag=0), 3.0277, tolerance=0.0001) all.equal(std(1:10, flag=1), 2.8723, tolerance=0.0001) all.equal(std_err(1:10), 0.9574271, tolerance=0.0001) pracma/tests/hypot.R0000644000176200001440000000017411540452742014153 0ustar liggesusers### ### h y p o t Tests ### hypot <- pracma::hypot identical(hypot(3,4), 5) identical(hypot(c(0,0), c(3,4)), c(3,4)) pracma/tests/cross.R0000755000176200001440000000070611540452742014145 0ustar liggesusers### ### cross.R +++ Test suite +++ ### test.cross <- function(input, expected) { output <- do.call(getFromNamespace("cross", "pracma"), input) identical(output, expected) } cross.expected.1 <- c(-3, 6, -3) #cross.expected. <- #cross.expected. <- #cross.expected. <- test.cross(list(x=c(1, 2, 3), y=c(4, 5, 6)), cross.expected.1) #test.cross(list(), cross.expected.) #test.cross(list(), cross.expected.) #test.cross(list(), cross.expected.) pracma/NEWS0000644000176200001440000013724214153353526012234 0ustar liggesusers------------------------------------------------------------------------------ pracma NEWS ------------------------------------------------------------------------------ CHANGES IN VERSION 2.3.6 (2021-12-06) o Corrected randortho() with return value 'q %*% diag(ph) # %*% q', as researched and reported by Daniel Kessler; thanks a lot. o Function deeve() requires the x-coordinates to be sorted. o Removed the Nile data (without warning). CHANGES IN VERSION 2.3.5 (2021-07-10) o Corrected a bug in subspace() - thanks to David Fleischer. o Corrected a small but annoying bug in steep_descent(). o Allows for complex matrices in pinv() (and mldivide()). CHANGES IN VERSION 2.3.4 (2021-03-18) o Small correction in movavg(): default type now is 's'. CHANGES IN VERSION 2.3.3 (2021-01-22) o Forgot to correct URL addresses in the Readme.md file. CHANGES IN VERSION 2.3.2 (2021-01-16) o Removed and corrected URL addresses from 'http' to 'https'. CHANGES IN VERSION 2.3.1 (2021-01-13) o 'ellipke' help page: compute the circumference of an ellipse. o 'Mode()' now handling all types of NAs (thx. Michael Henry). CHANGES IN VERSION 2.3.0 (2020-04-09) o circlefit(): option 'fast' is deprecated and will not be used. o gammainc(0, a) returns 0, thanks to Mark Chappell for reporting. o ndims() now returns 1 for vectors and 0 for empty objects. CHANGES IN VERSION 2.2.9 (2019-12-15) o Changed URL reference of Abramowitz and Stegun (link missing). o Fixed warning with the 'try' construct in several functions using 'if(inherits(e, "try-error"))' (help from Bert Gunter). o Link to R Base HTML help page gave a warning (for Windows). CHANGES IN VERSION 2.2.8 (2019-07-09) o erfi() returns real values when the input values are all real. o hypot() allows for scalar plus numeric vector as inputs. CHANGES IN VERSION 2.2.7 (2019-05-21) o Polynomial division with polydiv(); for two plynomials polygcf() finds the greatest common factor; and rootmult() returns the multiplicity of a polynomial root (or 0). o polyroots() refines the result of roots() in case of roots with multiplicities (where roots() is quite inaccurate). CHANGES IN VERSION 2.2.6 (2019-05-02) o All polynomial functions now accept complex coefficients, esp. roots() finds roots for complex polynomials. o Fixed a bug in laguerre() for zeros of complex polynomials. CHANGES IN VERSION 2.2.5 (2019-04-08) o fsolve() and broyden() are no longer applicable to univariate functions (Morrison-Sherman formula not working in this case). o Alias cgmin() and option 'dfree=F' in fminsearch() are removed, both have been deprecated since half a year. CHANGES IN VERSION 2.2.4 (2018-12-12) o qpsolve() minimizes quadratic forms such as 0.5*t(x)*x - d*x with linear quality and inequality constraints. o fmincon() now has an 'augmented Lagrangian' option with a 'variable metric' approach as inner solver. CHANGES IN VERSION 2.2.3 (2018-12-10) o linearproj() linear projection onto a linear subspace, and affineproj() linear projection onto an affine subspace of R^n. CHANGES IN VERSION 2.2.2 (2018-11-30) o Corrected "length > 1 in coercion to logical" in expm(). CHANGES IN VERSION 2.2.1 (2018-11-30) o fminunc() unconstrained minimization of nonlinear objective function, based on stripped-down 'Rvmmin' code by John Nash. o fmincon() minimization of nonlinear objective function with constraints; wraps suggested package NlcOptim with SQP method. CHANGES IN VERSION 2.2.0 (2018-11-27) o Reintroduced 'nelder_mead()' and 'hooke_jeeves()'. o fminsearch() now calls 'Nelder-Mead' or 'Hooke-Jeeves', i.e., derivative-free methods only; 'dfree=F' gets deprecated. CHANGES IN VERSION 2.1.9 (2018-11-22) o Renamed 'cgmin' to its original name 'fletcher_powell', alias 'cgmin' is deprecated since this version. o Removed alias 'normest2' that was anyway non-existing. CHANGES IN VERSION 2.1.8 (2018-10-16) o Corrected a bug in hessenberg() reported by Ben Ubah. CHANGES IN VERSION 2.1.7 (2018-09-24) o Removed the deprecated 'rortho' function, use randortho() instead. CHANGES IN VERSION 2.1.6 (2018-08-30) o Si(), Ci() sine and cosine integral functions added. o Added dot notation for brent(), bisect(), newton(), halley() and ridders() -- on request of John Nash for the histRalg project. CHANGES IN VERSION 2.1.5 (2018-08-25) CHANGES IN VERSION 2.1.4 (2018-01-29) o shubert() implements one-dimensional Shubert-Piyavskii method. o fminsearch() and anms() stop for one-dimensional minimization. CHANGES IN VERSION 2.1.3 (2018-01-23) o bsxfun() now uses sweep() for matrices in search of higher speed. o direct1d() removed because slow and not effective. CHANGES IN VERSION 2.1.2 (2018-01-21) o poisson2disk() approximate Poisson disk distribution o Corrected small bug in findpeaks(), reported by Mike Badescu. CHANGES IN VERSION 2.1.1 (2017-11-21) o Added a field "Authors@R" in the DESCRIPTION, deleted others. o Added README.md and NEWS.md (for a future Github repository). o Needed a new version for resubmitting (because of 'survivalsvm'). CHANGES IN VERSION 2.1.0 (2017-11-20) o Package 'quadprog' is now suggested, not imported; the functions quadprog() and lsqlincon() work only when 'quadprog' is installed. CHANGES IN VERSION 2.0.9 (2017-09-20) o Package byte-compiled on loading (Requires R version >= 3.1.0). CHANGES IN VERSION 2.0.8 (2017-09-20) o findpeaks() function not checking for NAs (reported by Wesley Burr). o fplot() extra parameters were not handed over to plotting routine. CHANGES IN VERSION 2.0.7 (2017-06-17) o bernstein() generates the Bernstein polynomial B_,_(). o legendre(n,_) corrected for n=0 (thanks to Peter W. Marcy). o cgmin() alias for fletcher_powell(), a constraint gradient method. CHANGES IN VERSION 2.0.6 (2017-06-06) o polyvalm() evaluates a polynomial in the matrix sense. o arnoldi() Arnoldi iteration (incl. Hessenberg matrix). CHANGES IN VERSION 2.0.5 (2017-04-30) o integral() redesigned, less methods, several starting intervals with regular or random intermediate nodes (similar to MATLAB). o quadgr() corrected as functions vectorized with Vectorize() did not behave as expected with apply(); still needs vectorization. o Help page of quadgk() did not mention the need for vectorization. CHANGES IN VERSION 2.0.4 (2017-04-01) o hessenberg() computes the Hessenberg form of a matrix through Householder transformations (this is named hess() in MATLAB). CHANGES IN VERSION 2.0.3 (2017-03-23) o Corrected functions with conditions in control statements with conditions of length greater than one: rem(). CHANGES IN VERSION 2.0.2 (2017-02-23) o isposdef() test for positive definiteness of a (real) matrix. o hooke_jeeves() removed; similar implementations are available in packages 'dfoptim::hjk[b]' and 'adagio::hookejeeves'. CHANGES IN VERSION 2.0.1 (2017-02-06) o nelder_mead() replaced by an adaptive Nelder-Mead implementation, anms(), following F. Gao and L. Han. o fminsearch() now calls this new version of Nelder-Mead. CHANGES IN VERSION 2.0.0 (2017-01-26) o incgam(x,a) computes the incomplete upper gamma function using the R function pgamma for higher precision than gammainc(). o Corrected a small oversight in hurstexp(), thnx George Ostrouchov. CHANGES IN VERSION 1.9.9 (2017-01-10) o Slightly changed the description lines on request of CRAN. CHANGES IN VERSION 1.9.8 (2017-01-10) o whittaker() finally implemented avoiding the sparse matrix package. o nelder_mead() now applies adaptive parameters for the simplicial search, depending on the dimension of the problem space. o psinc(x,n), the so-called periodic sinc function. CHANGES IN VERSION 1.9.7 (2016-12-14) o shooting() implements the shooting method for boundary value problems of second order differential equations. o interp2() corrected the help page with size(z) = length(y)*length(x). o Corrected a small oversight on the help page of Gauss-Laguerre. CHANGES IN VERSION 1.9.6 (2016-09-11) o haversine() Haversine formula for geographical distances on earth. o trigonometric functions accepting degrees instead of inputs in radians: sind cosd tand cotd secd cscd asind acosd atand acotd asecd acscd atan2d CHANGES IN VERSION 1.9.5 (2016-09-06) o fprintf() mimicks MATLAB's function of the same name. o Added ezsurf(), an easy surface plot following MATLAB. o fplot() is almost an alias for ezplot(); please note that in future versions ez...() will be renamed to f...() according MATLAB 2016/17. CHANGES IN VERSION 1.9.4 (2016-07-27) o rortho() renamed to randortho(), the underlying code was buggy (not truely random) and has been replaced, thanks to Jan Tuitman. o an error in the final step of calculating approx_energy() was corrected, thanks to Daniel Krefl. CHANGES IN VERSION 1.9.3 (2016-05-28) o bvp() now solves boundary value problems for linear 2nd order ODEs using a 'finite differences' approach and a tridiagonal solver. o polyfit2() has been removed, use polyfix() instead. CHANGES IN VERSION 1.9.2 (2016-03-04) o romberg() corrected an error estimation that diminished the accuracy. o trapzfun() realizes trapezoidal integration with iterated calculations. CHANGES IN VERSION 1.9.1 (2016-02-15) o fractalcurve() generates some fractal curves of order n, i.e. the Hilbert, Sierpinski, Snowflake, Dragon, and Molecule curves. o ode23(), ode23s() changed the size of the returned components, now it is similar to what is returned by ode45() and ode78(). o arclength() corrected a boundary condition ('on the left'), added an example how to generate an arc-length parametrization of a curve. CHANGES IN VERSION 1.9.0 (2015-12-17) o quadprog() solves quadratic programming problems (QP) with linear equality and inequality constraints, based on package 'quadprog'. o lsqlincon() solves linear least-squares problems with linear equality *and* inequality constraints (as well as bound constraints). o pracma now imports package 'quadprog'. CHANGES IN VERSION 1.8.9 (2015-12-05) o polyfix() fits a polynomial that exactly passes through given fixed points. polyfit2() will be deprecated in future versions. o Important bug fix for polyApprox() (thanks to Max Marchi). CHANGES IN VERSION 1.8.8 (2015-10-28) o Option 'minpeakdistance' for function findpeaks() added (thanks to Razvan Chereji for providing a workable approach). CHANGES IN VERSION 1.8.7 (2015-07-20) o Removed invperm(). o 'linear' is now the default method for interp1(). o Cases n = 0, 1 for legendre() corrected (thanks to Nuzhdin Yury). CHANGES IN VERSION 1.8.6 (2015-07-11) o Removed two non-existing links pointing to Gander's pages at the ETHZ. o Removed a link explaining approximate entropy. CHANGES IN VERSION 1.8.5 (2015-07-07) o Added 'Imports' field in description and 'import' in namespace, as requested for the new R development version. o strrep() renamed to strRep(), because of a new function in R Base. CHANGES IN VERSION 1.8.4 (2015-06-25) o bernoulli() calculates the Bernoulli numbers and polynomials. o factorial2() the product of all even resp. odd integers below n. CHANGES IN VERSION 1.8.3 (2015-02-08) o Deleted some URLs that were not working properly anymore. CHANGES IN VERSION 1.8.2 (2015-02-07) o Special functions gathered under topics 'specfun' resp. 'specmat'. CHANGES IN VERSION 1.8.1 (2015-02-06) o sumalt() accelerating (infinite) alternating sums. o Option 'fast=FALSE' in circlefit() to avoid optim(). o Added Gauss' AGM-based computation of pi to agmean(). CHANGES IN VERSION 1.8.0 (2015-01-26) o hurstexp() amended for vectors of uneven length. CHANGES IN VERSION 1.7.9 (2014-11-15) o qpspecial() special quadratic programming solver. o Reintroduces the 'tol' keyword in fminbnd() for compatibility. CHANGES IN VERSION 1.7.8 (2014-11-10) o bulirsch_stoer() Bulirsch-Stoer method for solving ordinary differential equations with high accuracy. o midpoint() implements the midpoint rule for solving ODEs combined with Richardson extrapolation for high accuracy. CHANGES IN VERSION 1.7.7 (2014-11-01) o lufact() LU factorization with partial pivoting; lusys() solves linear systems through Gaussian elimination. CHANGES IN VERSION 1.7.6 (2014-10-30) o ode23s() for stiff ordinary differential equations refining Rosenbrock's method (supply Jacobian if available). o euler_heun() Euler-Heun ODE solver has been corrected. CHANGES IN VERSION 1.7.5 (2014-10-20) o fminbnd() much improved implementation of Brent's method; added challenging example by Trefethen to the help page. o lambertWn() for the second (real) branch of Lambert W. o Function name alias cintegral() removed. CHANGES IN VERSION 1.7.4 (2014-10-13) o hooke_jeeves() replaced by a much more efficient implementation and equipped with a special approach to bound constraints. o nelder_mead() replaced by a much more efficient implementation and utilizing a transformation to handle bound constraints; functions nelmin() and nelminb() are not exported anymore. CHANGES IN VERSION 1.7.3 (2014-10-11) o quadinf() now uses the double exponential method with the tanh-sinh quadrature scheme for (semi-)infinite intervals. o Removed the not-exported and too slow .quadcc() function. o brent() alias for brentDekker(), newton() for newtonRaphson(). CHANGES IN VERSION 1.7.2 (2014-09-08) o pchipfun() function wrapper around pchip(); missing error handling in pchip() was added. o hurst() removed, functionality merged with hurstexp(). o Nile overflow data set 1871--1984 added as time series. CHANGES IN VERSION 1.7.1 (2014-08-12) o bits() binary representation of a number as string. o agmean() returns AGM, no of iterations, and estimated precision. o trapz() tiny improvement on error handling. CHANGES IN VERSION 1.7.0 (2014-06-30) o ode45() ODE solver using Dormand-Prince (4,5) coefficients. o ode78() ODE solver using Fehlberg (7,8) coefficients. o cintegral() renamed to line_integral(). CHANGES IN VERSION 1.6.9 (2014-06-14) o Version 1.6.8 "Failed to build" on R-Forge. [Maybe it's time to move pracma to a github repository.] CHANGES IN VERSION 1.6.8 (2014-06-07) o nelmin() a more efficient and accurate version of Nelder-Mead. o nelminb() Nelder-Mead in bounded regions (applies a transformation). CHANGES IN VERSION 1.6.7 (2014-05-23) o trisolve() stopping for singular tridiagonal matrices. o romberg() slightly improved accuracy and speed. CHANGES IN VERSION 1.6.6 (2014-04-12) o Corrected rref() (as pointed out by Peter Audano). CHANGES IN VERSION 1.6.5 (2014-02-24) o lsqnonneg() changed to an active-set approach. o bisect() trimmed bisection to return almost exact results. CHANGES IN VERSION 1.6.4 (2014-02-05) o halley() Halley's variant of the Newton-Raphson method. o numderiv() corrected Richardson's method by breaking the loop. CHANGES IN VERSION 1.6.3 (2014-01-25) o lambertWp() improved inner accuracy from 1e-12 to 1e-15. o complexstepJ() renamed to jacobian_csd(); introduced grad_csd(). o hessian_csd() applies Richardson's method as the second step, and the same for laplacian_csd(). CHANGES IN VERSION 1.6.2 (2014-01-19) o Removed zeroin(); for fzero() a variation of Brent-Dekker is used, that applies cubic instead of quadratic interpolation. o Corrected an oversight in newtonRaphson(). o brentDekker() returns a list now. CHANGES IN VERSION 1.6.1 (2014-01-14) o samp_entropy() complements approx_entropy() for short time series. o Removed NEWS.Rd and NEWS.pdf in favour of NEWS. CHANGES IN VERSION 1.6.0 (2013-12-06) o integral3() now handles functions as inner interval limits. o poly_crossings() calculates crossing points of two polygons. o erfz() complex error function vectorized (thanks to Michael Lachmann). CHANGES IN VERSION 1.5.9 (2013-11-30) o muller() implements Muller's root-finding method [Mueller, 1956], especially suited for polynomials and complex functions. o Inserted a safeguard for the distmat() function to prevent different results on Mac OS X, (Ubuntu) Linux, and Windows operating systems. o Removed pltcross() and kmeanspp(). CHANGES IN VERSION 1.5.8 (2013-11-28) o interp1() with option method ``spline'' now computes Moler's spline functions, for compatibility with MATLAB (hint by Boudewijn Klijn). CHANGES IN VERSION 1.5.7 (2013-10-11) o Corrected parameter 'waypoints' in cintegral(). CHANGES IN VERSION 1.5.6 (2013-09-22) o odregress() orthogonal distance (or: total least-squares) regression. o Changed maintainer name to its long form (CRAN request). CHANGES IN VERSION 1.5.5 (2013-09-11) o L1linreg() L1 (a.k.a. LAD or median) linear regression. o geo_median() geometric median (minimizes sum of distances). CHANGES IN VERSION 1.5.4 (2013-08-31) o rectint() rectangular intersection areas (MATLAB style). o cumtrapz() cumulative trapezoidal integration (MATLAB style). o Some corrections to help pages and function names. CHANGES IN VERSION 1.5.3 (2013-08-25) o arclength() length of a parametrized curve in n-dimensional space, w/ improved convergence by applying Richardson's extrapolation method. o legendre() associated Legendre functions (MATLAB style). CHANGES IN VERSION 1.5.2 (2013-08-23) o poly_center() calculates the center coordinates of a polygon. o poly_length() calculates the (euclidean) length of a polygon. o polyarea() corrected, returns the true, not the absolute value. CHANGES IN VERSION 1.5.1 (2013-08-19) o fsolve() will use broyden() if m = n; fzsolve() the same; additionally, improved broyden() and gaussNewton(). o ezplot() can draw markers on the line, with equal distances measured along the curve length. CHANGES IN VERSION 1.5.0 (2013-08-08) o gmres() generalized minimum residual method. o nearest_spd() finds nearest symmetric positive-definite matrix. o eps() floating point relative accuracy. CHANGES IN VERSION 1.4.9 (2013-07-16) o lapacian() now works in n dimensions, not only for n = 2. o mldivide(), mrdivide() corrected a severe typo. o numderiv(), numdiff() start with h = 1/2 instead of h = 1. o figure() platform-independent by using dev.new(). CHANGES IN VERSION 1.4.8 (2013-06-17) o findzeros() now finds 'quadratic' roots, too. o pdist2() added as an alias for distmat(), while pdist(X) now is distmat(X, X) (MATLAB style). CHANGES IN VERSION 1.4.7 (2013-05-20) o histcc() histogram with optimized number of bins. o Example of correction term for the trapz() integration. CHANGES IN VERSION 1.4.6 (2013-03-31) o psi() Psi polygamma function (MATLAB style). o rosenbrock() and rastrigin() functions removed. CHANGES IN VERSION 1.4.5 (2013-03-21) o quadcc() new, iterative Clenshaw-Curtis quadrature. o squareform() formats distance matrix (MATLAB style). CHANGES IN VERSION 1.4.4 (2013-03-12) o integral2() implements the two-dimensional numerical integration approach `TwoD', i.e. Gauss-Kronrod (3, 7)-points on rectangles. o integral3() three-dimensional integration based on integral2(). o triplequad() 3-dim. integration based on dblquad() (MATLAB style). CHANGES IN VERSION 1.4.3 (2013-03-10) o integral() combines adaptive numerical integration procedures. o cintegral() complex line integrals (rectangles and curves). CHANGES IN VERSION 1.4.2 (2013-03-03) o linprog() linear programming solver for linear equality and inequality constraints. CHANGES IN VERSION 1.4.1 (2013-02-20) o romberg() Romberg integration completely rewritten. o idivide() integer division with different roundings. CHANGES IN VERSION 1.4.0 (2013-02-10) o fderiv(), taylor() expanded to higher orders. o itersolve() iteration methods for solving linear systems. o lu() LU decomposition with different schemes (w/o pivoting). CHANGES IN VERSION 1.3.9 (2013-01-26) o pdist() as an alias for distmat() (MATLAB style). o fftshift(), ifftshift() shifting Fourier frequencies. o Improved grad(), jacobian(), hessian(), and laplacian(). CHANGES IN VERSION 1.3.8 (2013-01-10) o Smaller corrections, e.g., removed deprecated 'is.real'; no startup messages anymore. o geomean(), harmmean(), trimmean() geometric, harmonic, and trimmed arithmetic mean (MATLAB style). o agmean() algebraic-geometric mean. CHANGES IN VERSION 1.3.7 (2013-01-07) o mexpfit() multi-exponentiell fitting, separating linear and nonlinear parts of the problem. CHANGES IN VERSION 1.3.6 (2013-01-06) o lsqsep() separable least-squares fitting. o lsqcurvefit() nonlinear least-squares curve fitting. CHANGES IN VERSION 1.3.5 (2013-01-05) o cd(), pwd() directory functions (MATLAB style). o rand(), randn() changed to accept size() as input. o whos(), what() corrected for empty lists resp. directories. CHANGES IN VERSION 1.3.4 (2012-12-19) o what(), who(), whos(), ver() (MATLAB style). o semilogx(), semilogy(), loglog() logarithmic plots (MATLAB style) CHANGES IN VERSION 1.3.3 (2012-12-12) o quadv() vectorized integration. o ezpolar() easy access to the polar() function. o sortrows() sorting rows of matrices (MATLAB style). o null() alias for nullspace function (MATLAB style). o eigjacobi() Jacobi's method for eigenvalues and eigenvectors. CHANGES IN VERSION 1.3.2 (2012-12-08) o ellipke(), ellipj() elliptic and Jacobi elliptic integrals. o expint() implements E1 and Ei, the exponential integrals, with aliases expint_E1() and expint_Ei(). o li() the logarithmic integral (w/o offset). CHANGES IN VERSION 1.3.1 (2012-12-06) o Explicitely listing about 200 MATLAB-emulating function( name)s. o Dismissed matlab(), using it now for infos only, not assigning any MATLAB function names to the environment (because of CRAN policies). CHANGES IN VERSION 1.3.0 (2012-12-05) o cot(), csc(), sec() cotangens, cosecans, and secans functions. o acot(), acsc(), asec() inverse cotangens, cosecans, secans functions. o coth(), csch(), sech() hyperbolic cotangens, cosecans, secans functions. o acoth(), acsch(), asech() inverse hyperbolic cotangens, cosecans, and secans functions. CHANGES IN VERSION 1.2.9 (2012-12-02) o bvp() changed to solve second order boundary value problems. o trisolve() solves tridiagonal linear equation systems. o curvefit() fits points in the plane with a polynomial curve. CHANGES IN VERSION 1.2.8 (2012-11-30) o lsqlin() least-squares solver with linear equality constraints. o pinv() now works like MASS::ginv() for singular matrices. o Added the end-';' feature to str2num(). o toc() added invisible return value. CHANGES IN VERSION 1.2.7 (2012-11-22) o procrustes() solving the Procrustes problem, and kabsch() implements the Kabsch algorithm. o kriging() ordinary and simple Kriging interpolation. o Corrected some stupid errors in str2num(). CHANGES IN VERSION 1.2.6 (2012-11-11) o akimaInterp() univariate Akima interpolation. o Moved transfinite() to package 'adagio'. CHANGES IN VERSION 1.2.5 (2012-10-28) o histc() Histogram-like counting (MATLAB style). o Added warning to complexstep() if imaginary part is zero. CHANGES IN VERSION 1.2.4 (2012-10-25) o Added option 'pinv' to mldivide() to return same results as MATLAB. o str2num(), num2str() conversion functions (MATLAB style). o Removed some 'author' entries on help pages. CHANGES IN VERSION 1.2.3 (2012-10-17) o Renamed mrank() to Rank(). o Corrected nullspace() [thanks to Stephane Laurent], which now agrees with Octave's null() function (MASS:Null appears buggy, too). o Corrected gaussNewton() and fsolve() [thanks to Etienne Chamayou]. CHANGES IN VERSION 1.2.2 (2012-10-10) o bsxfun() apply binary function elementwise (MATLAB style). o added the analytic solution for the example in bvp(). CHANGES IN VERSION 1.2.1 (2012-09-28) o rosenbrock() added, moved testfunctions to 'adagio' package. o euler_heun() improved Euler method for solving ODEs. o logit() function added to sigmoid(). o Keyword 'ode' introduced. CHANGES IN VERSION 1.2.0 (2012-09-27) o matlab() can reinstall MATLAB function names. CHANGES IN VERSION 1.1.9 (2012-09-25) o gcd(), lcm() greatest common divisor, least common multiple now working on a vector of integers. o Removed number-theoretic functions: eulersPhi(), moebiusFun(), mertensFun(), sigma(), tau(), omega(), Omega(), primes2(), twinPrimes(), nextPrime(), previousPrime(), modpower(), modorder(), modinv(), modlin(), primroot(), contfrac(), coprime(), GCD(), LCM(), extGCD(), (these functions are now available in the 'numbers' package). CHANGES IN VERSION 1.1.8 (2012-09-19) o ezcontour(), ezmesh() wrappers for contour(), image(), persp(). o erfi() imaginary error function. CHANGES IN VERSION 1.1.7 (2012-08-06) o moler() Moler matrix CHANGES IN VERSION 1.1.6 (2012-07-20) o Removed '.Rapphistory' from the tests directory (again) [and use "--as-cran" for the checks]. o disp() display text or array (MATLAB Style), i.e. cat() with newline. CHANGES IN VERSION 1.1.5 (2012-07-18) o Renamed functions with capital first letter to avoid name clashes: mtrace -> Trace, mdiag -> Diag, strtrim -> strTrim, vnorm -> Norm, reshape -> Reshape, find -> finds, fix -> Fix, poly ->Poly, mode -> Mode, real -> Real, imag -> Imag, toeplitz -> Toeplitz. CHANGES IN VERSION 1.1.4 (2012-06-26) o gammainc() (lower and upper) incomplete gamma function, also the regularized gamma function, all allowing negative x values. o polylog() the polylogarithm functions for |z| < 1 and n >= -4 . CHANGES IN VERSION 1.1.3 (2012-06-17) o fminsearch() now implements Nelder-Mead (similar to optim), and Fletcher-Powell when ``dfree=FALSE'' is chosen. o Test functions rosenbrock() and rastrigin(). CHANGES IN VERSION 1.1.2 (2012-06-13) o nelder_mead() implements Nelder-Mead for nonlinear optimization. o hooke-jeeves() Hooke-Jeeves algorithm for direct search. o fletcher_powell() Davidon-Fletcher-Powell method for function minimization (alternative to BFGS approach). o steep_descent() minimization of functions using steepest descent. CHANGES IN VERSION 1.1.1 (2012-06-10) o fminbnd() now implements Brent's function minimization algorithm with golden section search and parabolic interpolation (same as optimize). o transfinite() transformation function between bounded and unbounded (box constraint) regions. CHANGES IN VERSION 1.1.0 (2012-06-06) o hurst(), hurstexp() calculate the Hurst exponent of a time series. o Updated the NEWS.Rd file. CHANGES IN VERSION 1.0.9 (2012-06-03) o lsqnonneg() solves nonnegative least-squares problems by using the trick "x --> exp(x)" and applying lsqnonlin(); example function lsqcurvefit() for nonlinear curve fitting. o Renamed ridder() to ridders(), thanks to Robert Monfera for pointing it out (he also suggested a multi-dimensional variant). CHANGES IN VERSION 1.0.8 (2012-05-22) o movavg() moving average of types "simple", "weighted", "modified", "exponential" (EMA), or "triangular". o modlin() solves modular linear equations. CHANGES IN VERSION 1.0.7 (2012-05-11) o lsqnonlin() solves nonlinear least-squares problems using the Levenberg-Marquardt approach. o renamed froots() to findzeros(), and fmins() to findmins(). CHANGES IN VERSION 1.0.6 (2012-04-21) o fornberg() finite difference (i.e., polynomial) approximation of derivatives for unevenly spaced grid points -- Fornberg's method. CHANGES IN VERSION 1.0.5 (2012-04-15) o randsample() randomly sampling, alias for sample (MATLAB style). o rands() generates uniform random points on an N-sphere. o Added tic(), toc() measuring elapsed time (MATLAB style). o previousPrime() finds the next prime below a number. CHANGES IN VERSION 1.0.4 (2012-04-01) o invlap() computes the inverse Lapacian numerically. o ppfit() piecewise polynomial fitting procedure. CHANGES IN VERSION 1.0.3 (2012-03-21) o cubicspline() interpolating cubic spline (w/ endpoint conditions). o mkpp() and ppval() for piecewise polynomial structures. CHANGES IN VERSION 1.0.2 (2012-03-17) o accumarray() resembles the related MATLAB function more closely. o invperm() returns the inverse of a permutation. o randperm() changed to make it more MATLAB-like. CHANGES IN VERSION 1.0.1 (2012-03-09) o plotyy() corrected right ordinate, prettying the labels. o peaks() peaks function (MATLAB style). CHANGES IN VERSION 1.0.0 (2012-03-01) o Updated the NEWS.Rd file. CHANGES IN VERSION 0.9.9 (2012-02-29) o qrSolve solves overdetermined system of linear equations. o DSCsearch() removed, now in package 'pracopt'. o randp() found a better, non-selective approach. CHANGES IN VERSION 0.9.8 (2012-02-23) o gramSchmidt() modified Gram-Schmidt process. o householder() Householder reflections and QR decomposition. o givens() Givens rotation and QR decomposition. o corrected a small error in ridder() (thanks to Roger Harbord); new example of how to use ridder() with Rmpfr for multiple precision. CHANGES IN VERSION 0.9.7 (2012-02-17) o erf() corrected, erfc() and erfcx() as new functions, including their inverses erfinv() and erfcinv(). o hypot() now numerically more stable (thanks to Jerry Lewis). CHANGES IN VERSION 0.9.6 (2012-01-25) o Changed third example for dblquad() [new Windows toolchain problem]. o Deactivated the test for gammaz() because of problems on Solaris. CHANGES IN VERSION 0.9.5 (2012-01-16) o kmeanspp() kmeans++ clustering algorithm. o hampel() with new option, fuelled by a blog entry of Ron Pearson. CHANGES IN VERSION 0.9.4 (2012-01-08) o DSCsearch() Davies-Swann-Campey search in one dimension. o Improved modpower() through modular exponentiation. added lehmann_test() Lehmann's primality test as example. o Corrected polar() and andrewsplot(). CHANGES IN VERSION 0.9.3 (2011-12-27) o direct1d() one-dimensional version of the DIRECT algorithm for global function minimization. CHANGES IN VERSION 0.9.2 (2011-12-26) o approx_entropy() approximate entropy of a time series. o circshift() circularly shifting arrays (MATLAB Style). CHANGES IN VERSION 0.9.1 (2011-12-12) o plotyy() plots curves with y-axes on both left and right side. o fplot() plots components of a multivariate function. CHANGES IN VERSION 0.9.0 (2011-12-11) o errorbar() routine for plotting error bars in both directions. o whittaker() Whittaker-Henderson smoothing ** Not yet running** . o rref() reduced row echelon form. CHANGES IN VERSION 0.8.9 (2011-12-08) o cutpoints() automatically finds cutting points based on gaps. o hausdorff_dist calculates the Hausdorff distance / Hausdorff dimension. o nnz() number of non-zeros elements (MATLAB style). CHANGES IN VERSION 0.8.8 (2011-12-06) o polar() for polar plots (MATLAB style), see the example plots. o andrewsplot() plots Andrews curves in polar coordinates. o Vectorized: cart2sph(), sph2cart(), cart2pol(), pol2cart(). CHANGES IN VERSION 0.8.7 (2011-11-30) o deg2rad(), rad2deg(). o figure() MATLAB style and pltcross() plotting crosses. CHANGES IN VERSION 0.8.6 (2011-11-21) o ridder() Ridder's method for zero finding of univariate functions. CHANGES IN VERSION 0.8.5 (2011-11-19) o sqrtm() matrix square root, based on Denman-Beavers iteration, rootm() matrix p-th root, computing a complex contour integral, signm() matrix sign function. o fzero() now uses the new zeroin() function, i.e., a Brent-Dekker approach instead of refering to uniroot(). o twinPrimes() twin primes in a given interval, and nextPrime() will find the next higher prime. CHANGES IN VERSION 0.8.4 (2011-11-14) o Transformations between cartesian, spherical, polar and cylindrical coordinate systems: cart2sph(), sph2cart(), cart2pol(), pol2cart(). o randp() uniformly random points in the unit circle. CHANGES IN VERSION 0.8.3 (2011-11-11) o accumarray() grouping elements and applying a function to each group. o uniq() MATLAB-style 'unique' function, allsums() in the examples. o small correction to fsolve(), mentioned on the 'check summary' page. CHANGES IN VERSION 0.8.2 (2011-11-04) o newmark() Newmark's method for solving second order differential equations of the form y''(t) = f(t, y(t), y'(t)) on [t1, t2]. o cranknic() Crank-Nicolson 'ivp' solver, combining the forward and backward Euler methods for ordinary differential equations. CHANGES IN VERSION 0.8.1 (2011-10-30) o Corrected pinv() for (nearly) singular matrices. o Renamed ifactor() to factors(). CHANGES IN VERSION 0.8.0 (2011-10-27) o Minor corrections and improvements to the 'pracma.pdf' manual, incl. numdiff(), refindall(), trigApprox(), and subspace(). CHANGES IN VERSION 0.7.9 (2011-10-22) o spinterp() monotonic (and later on shape-preserving) interpolation following the approach of Delbourgo and Gregory. CHANGES IN VERSION 0.7.8 (2011-10-17) o bvp() solves boundary value problems of the following kind: -u''(x) + c1 u'(x) + c2 u(x) = f(x) for x in [a, b]. CHANGES IN VERSION 0.7.7 (2011-10-14) o primes2(n1, n2) will return all prime numbers betweeen n1 and n2 (without storing the numbers from sqrt(n2) up to n2). CHANGES IN VERSION 0.7.6 (2011-08-05) o gaussNewton() for function minimization and solving systems of nonlinear equations. fsolve() as a wrapper for it. o fzsolve() for root finding of complex functions. o softline() Fletcher's inexact linesearch algorithm. CHANGES IN VERSION 0.7.5 (2011-07-26) o Put NEWS.Rd in the /inst subdirectory (and NEWS.pdf in /doc), thanks to Kurt Hornik; slightly changed the version numbering. CHANGES IN VERSION 0.7-4 (2011-07-22) o rortho() generate random orthogonal matrix of size n. o Titanium data set for testing fitting procedures. CHANGES IN VERSION 0.7-3 (2011-07-15) o erf() and erfc() error and complementary error functions (MATLAB style) as (almost) aliases for pnorm(). o erfz() complex error function. CHANGES IN VERSION 0.7-2 (2011-07-11) o broyden() quasi-Newton root finding method for systems of nonlinear equations. CHANGES IN VERSION 0.7-1 (2011-07-09) o cross() has been vectorized (remark on R-help). CHANGES IN VERSION 0.7-0 (2011-07-07) o Sigmoid and Einstein functions. CHANGES IN VERSION 0.6-9 (2011-07-06) o Runge-Kutta-Fehlberg method of order (5,4). CHANGES IN VERSION 0.6-8 (2011-07-05) o triquad() Gaussian quadrature over triangles. o cotes() Newton-Cotes integration formulae for 2 to 8 nodes. CHANGES IN VERSION 0.6-7 (2011-07-04) o lagrangeInterp(), newtonInterp() Lagrange and Newton polynomial interpolation, neville() Neville's methods. o tril(), triu() extracting triangular matrices (MATLAB style). CHANGES IN VERSION 0.6-6 (2011-07-02) o charpoly() computes the characteristic polynomial, the determinant, and the inverse for matrices that are relativly small, applying the Faddejew-Leverrier method. o froots() to find *all* roots (also of second or higher order) of a univariate function in a given interval. The same with fmins() to find *all* minima. CHANGES IN VERSION 0.6-5 (2011-07-01) o Adams-Bashford and Adams-Moulton (i.e., multi-step) methods for ordinary differential equations in function abm3pc(). CHANGES IN VERSION 0.6-4 (2011-06-30) o Changed the description to be more precise about the package. CHANGES IN VERSION 0.6-3 (2011-06-28) o rationalfit() rational function approximation o ratinterp() rational interpolation a la Burlisch-Stoer. CHANGES IN VERSION 0.6-2 (2011-06-26) o pade() Pade approximation. CHANGES IN VERSION 0.6-1 (2011-06-25) o quadgk() adaptive Gauss-Kronrod quadrature. CHANGES IN VERSION 0.6-0 (2011-06-24) o Added differential equation example to expm()'s help page. o Changed NEWS file to become simpler (no subsections). CHANGES IN VERSION 0.5-9 (2011-06-23) o quadl() recursive adaptive Gauss-Lobatto quadrature. o simpadpt() another recursively adaptive Simpson's rule. o Added testing procedures for all integration routines; corrected, refined some of these procedures. CHANGES IN VERSION 0.5-8 (2011-06-20) o quadgr() Gaussian Quadrature with Richardson extrapolation, can handle singularities at endpoints and (half-)infinite intervals. CHANGES IN VERSION 0.5-7 (2011-06-18) o expm() for matrix exponentials. o clenshaw_curtis() the Clenshaw-Curtis quadrature formula. CHANGES IN VERSION 0.5-6 (2011-06-17) o simpson2d() as non-adaptive 2-dimensional Simpson integration. o dblquad() twofold application of internal function integrate(). CHANGES IN VERSION 0.5-5 (2011-06-15) o gaussHermite() and gaussLaguerre() for infinite intervals. o Fresnel integrals fresnelS() and frenelC(). CHANGES IN VERSION 0.5-4 (2011-06-12) o gaussLegendre() computes coefficients for Gauss Quadrature, and quad2d() uses these weights for 2-dimensional integration. o quadinf() wrapper for integrate() on infinite intervals. CHANGES IN VERSION 0.5-3 (2011-06-06) o ode23() solving first order (systems of) differential equations. o barylag2d() 2-dimensional barycentric Lagrange interpolation. CHANGES IN VERSION 0.5-2 (2011-06-04) o interp2() for two-dimensional interpolation. o gradient() now works in two dimensions too. CHANGES IN VERSION 0.5-1 (2011-06-01) o fzero(), fminbnd(), fminsearch(), fsolve() as aliases for uniroot(), optimize(), optim() with Nelder-Mead, newtonsys(). CHANGES IN VERSION 0.5-0 (2011-05-31) o Corrections to help pages. CHANGES IN VERSION 0.4-9 (2011-05-30) o romberg() and gauss_kronrod() for numerical integration. o Richardson's extrapolation in numderiv(), numdiff(). o Discrete numerical derivatives (one dimension): gradient(). CHANGES IN VERSION 0.4-8 (2011-05-28) o Numerical function derivatives: fderiv(), grad(). o Specialized operators: hessian(), laplacian(). o Application: taylor(). CHANGES IN VERSION 0.4-7 (2011-05-27) o plot vector fields: quiver() and vectorfield(). o findintervals(). o Corrections in deval(), deeve(), using findintervals(). CHANGES IN VERSION 0.4-6 (2011-05-26) o Laguerre's method laguerre(). o rk4() and rk4sys() classical fourth order Runge-Kutta. o deval(), deeve() evaluate ODE solutions. CHANGES IN VERSION 0.4-5 (2011-05-24) o Lebesgue coefficient: lebesgue(). o poly2str() for string representation of a polynomial. CHANGES IN VERSION 0.4-4 (2011-05-23) o Dirichlet's eta() and Riemann's zeta() function. o rmserr() different accuracy measures; std_err() standard error. CHANGES IN VERSION 0.4-3 (2011-05-22) o polypow() and polytrans() for polynomials. o polyApprox() polynomial approximation using Chebyshev. o trigPoly(), trigApprox() for trigonometric regression. CHANGES IN VERSION 0.4-2 (2011-05-17) o segm_intersect() and segm_distance() segment distances. o inpolygon(). CHANGES IN VERSION 0.4-1 (2011-05-13) o polyadd() polynomial addition. o conv() and deconv() time series (de)convolution. o detrend() removes (piecewise) linear trends. o ifft() for normalized inverse Fast Fourier Transform. CHANGES IN VERSION 0.4-0 (2011-05-10) o Added tests for functions since version 0.3-7. CHANGES IN VERSION 0.3-9 (2011-05-09) o and() and or(). CHANGES IN VERSION 0.3-8 (2011-05-06) o pchip() and option `cubic' for interp1() interpolation. o The complex gamma functions gammaz(). o hadamard() and toeplitz() matrices. CHANGES IN VERSION 0.3-7 (2011-05-04) o Rank of a matrix, mrank(), and nullspace() for the kernel. o orth(), orthogonal basis of the image space, and subspace() determines the angle between two subspaces. o normest() for estimating the (Frobenius) norm of a matrix, and cond() determines the condition number of a matrix. CHANGES IN VERSION 0.3-6 (2011-04-30) o fact(), more accurate than the R internal function `factorial'. o ezplot() as an alias for curve(), but with option ``fill = TRUE''. o aitken() for accelerating iterations. o Renamed polycnv() to polymul(). o Renamed outlierMAD() to hampel(). CHANGES IN VERSION 0.3-5 (2011-04-23) o Lambert W function lambertWp() for the real principal branch. o ``Complex Step'' derivation with complexstep() and complexstepJ(). CHANGES IN VERSION 0.3-4 (2011-04-21) o Barycentric Lagrange interpolation through barylag(). o polyfit2() fits a polynomial that exactly meets one additional point. o Added more references to the help entry `pracma-package.Rd'. CHANGES IN VERSION 0.3-3 (2011-04-19) o hornerdefl() for also returning the deflated polynomial. o newtonHorner() combining Newton's method and the Horner scheme for root finding for polynomials. o jacobian() computes the Jacobian of a function R^n --> R^m as simple numerical derivative. o newtonsys() applies Newton's method to functions R^n --> R^n with special application to root finding of complex functions. o newton() renamed to newtonRaphson(). CHANGES IN VERSION 0.3-2 (2011-04-17) o Sorting functions: bubbleSort(), insertionSort(), selectionSort(), shellSort(), heapSort(), mergeSort(), mergeOrdered(), quickSort(), quickSortx(), is.sorted(), and testSort(). o Functions from number theory: eulersPhi(), moebiusFun() and the mertensFun(), sigma(), tau(), omega(), and Omega(). CHANGES IN VERSION 0.3-1 (2011-04-16) o Chebyshev polynomials of the first kind: chebPoly(), chebCoeff(), and chebApprox(). CHANGES IN VERSION 0.3-0 (2011-04-09) o New version of NEWS.Rd, NEWS.pdf. o More test functions for root finding and quadrature. CHANGES IN VERSION 0.2-9 o fnorm() and the Runge function runge(). o contfrac(), rat(), and rats() for continuous fractions. o meshgrid() and magic(). CHANGES IN VERSION 0.2-8 o quad() adaptive Simpson quadrature. o Minimum finding with fibsearch() and golden_ratio(). o Root finding with newton(), secant(), and brentDekker(). CHANGES IN VERSION 0.2-7 o Regular expression functions regexp(), regexpi(), regexprep() and refindall(). CHANGES IN VERSION 0.2-6 o String functions blanks(), strtrim(), deblank(), strjust(), strrep(). o interp1() one-dimensional interpolation (incl. spline) CHANGES IN VERSION 0.2-5 o MATLAB functions mode(), clear() and beep(). CHANGES IN VERSION 0.2-4 o primroot() finds the smallest primitive root modulo a given n; needed functions are modpower() and modorder(). o humps() and sinc(): MATLAB test functions. o Root finding through bisection: bisect(), regulaFalsi(). o outlierMAD(), findpeaks(), and piecewise(). o polycnv() for polynomial multiplication. o Functions extgcd(), gcd(), and lcm() have been renamed to extGCD(), GCD(), and LCM() respectively. CHANGES IN VERSION 0.2-3 o strfind(), strfindi(), and findstr(). o circlefit() fitting a circle to plane points. o mldivide() and mrdivide(), emulating the MATLAB backslash operator. CHANGES IN VERSION 0.2-2 o vnorm() vector norm o Warning about a nasty "non-ASCII input" in the savgol.RD file resolved. CHANGES IN VERSION 0.2-1 (2011-03-17) o horner() implementing the horner scheme for evaluating a polynomial and its derivative. o savgol() Savitzki-Golay smoothing and needed pseudoinverse pinv(). RESTARTED AS VERSION 0.2-0 NAME CHANGE o Package renamed to 'pracma' to avoid name clashes with packages such as 'matlab' that are sticking closer to the original. o Added 'pracma-package' section to the manual. CHANGES IN VERSION 0.1-9 (2011-03-13) o reshape(), repmat(), and blkdiag() matrix functions. o combs() chooses all combinations of k elements out of n, and randcomb() generates a random selection. o perms() generates all permutations, randperm() a random permutation. o Pascal triangle as pascal(); nchoosek() returns binomial coefficients. o Some string functions: strcmp(), strcmpi(), strcat(). CHANGES IN VERSION 0.1-8 (2011-03-10) o std() as refinement of the standard deviation function. o ceil() and fix() as aliases for ceiling() and trunc(). [floor() and round() already exist in R.] o Modulo functions mod(), rem() and integer division idiv(). o Integer functions related to the Euclidean algorithm: extgcd(), gcd(), lcm(), coprime(), and modinv(). o distmat() and crossn(), the vector product in n-dimensional space. CHANGES IN VERSION 0.1-7 (2011-03-08) o size(), numel(), ndims(), isempty(), and find(). o eye(), ones(), zeros(). o Functions returning random numbers: rand(), randn(), randi(). o linspace(), logspace(), and logseq() for linearly, logarithmically, and exponentially spaced sequences. CHANGES IN VERSION 0.1-6 (2011-03-06) o Matrix functions mdiag() and mtrace() added. inv() is introduced as an alias for solve() in R. o Generate special matrices hankel(), rosser(), and wilkinson(). kron() is an alias for the R function kronecker(). o Renamed factors() to ifactor() to distinguish it more clearly from factors as used in R. CHANGES IN VERSION 0.1-5 o Added function for flipping or rotating numeric and complex matrices: flipdim(). flipud(), fliplr(), and rot90(). CHANGES IN VERSION 0.1-4 o Added functions for generating sequences of (log-)linearly spaced numeric values: linspace() and logspace(). o Added basic complex functions real(), imag(), conj(), and angle() which are essentially only aliases of the R functions Re(), Im(), or Conj(). angle() returns the angle of a complex number in radians. The R function Mod() is here only available as abs(). CHANGES IN VERSION 0.1-3 (2011-02-20) o Added compan() function for the `companion' matrix; the eig() function is an alias for the R eigen()values function. o Added the polynomial functions poly(), polyder(), polyfit(), polyint(), and polyval(). o roots() returns real and complex roots of polynomials. o Simplified the trapz() function. CHANGES IN VERSION 0.1-2 o Added functions from number theory: primes(), isprime() and factors(). The corresponding function for factors() in MATLAB/Octave is called factor(), but that name should not be shadowed in R! o Added the polyarea() and trapz() functions. CHANGES IN VERSION 0.1-1 o Added some simple functions such as nthroot(), pow2(), and nextpow2(). o dot() and cross() functions for scalar and vector product. o Generate matrices through vander() and hilb(). INITIAL VERSION 0.1-0 INSTALLATION o 'pracma' will be a pure R package without using any source code. Therefore, installation will be immediate on all platforms. INTENTION o This package provides R implementations of more advanced math functions from MATLAB and Octave (and the Euler Math Toolbox) with a special view on optimization and time series routines. pracma/COPYING0000644000176200001440000000135214024777552012566 0ustar liggesusers## Copyright (c) 2015 Hans W Borchers ## ## 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 3, or (at your option) ## any later version. ## ## These functions are distributed in the hope that they 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. ## ## The text of the GNU General Public License, version 3, is available ## at or by writing to the Free Software ## Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ## pracma/R/0000755000176200001440000000000014153356041011720 5ustar liggesuserspracma/R/strings.R0000644000176200001440000000462112546667755013564 0ustar liggesusers## ## s t r i n g s . R ## strcat <- function(s1, s2 = NULL, collapse = "") { stopifnot(is.character(collapse)) if (!is.vector(s1, mode = "character")) stop("Argument 's1' must be a character vector.") if (is.null(s2)) { paste(s1, collapse=collapse) } else { if (!is.vector(s2, mode = "character")) stop("Argument 's2' must be a character vector.") else paste(rep(s1, each = length(s2)), s2, sep = collapse) } } strcmp <- function(s1, s2) { if (!is.vector(s1, mode="character") || !is.vector(s1, mode="character")) stop("Arguments 's1' and 's2' must be character vectors.") if (length(s1) == length(s2)) all(s1 == s2) else FALSE } strcmpi <- function(s1, s2) { if (!is.vector(s1, mode="character") || !is.vector(s1, mode="character")) stop("Arguments 's1' and 's2' must be character vectors.") strcmp(tolower(s1), tolower(s2)) } strTrim <- function(s) { if (! is.character(s)) stop("Argument 's' must be a character vector.") sub("\\s+$", "", sub("^\\s+", "", s)) } deblank <- function(s) { if (! is.character(s)) stop("Argument 's' must be a character vector.") sub("\\s+$", "", s) } blanks <- function(n = 1) { stopifnot(is.numeric(n), length(n) == 1, n >= 0) n <- floor(n) paste(rep(" ", n), collapse="") } strjust <- function(s, justify = c("left", "right", "center")) { if (! is.character(s)) stop("Argument 's' must be a character vector.") justify <- match.arg(justify) s <- strTrim(s) n <- length(s) M <- nchar(s) m <- max(M) S <- character(n) for (i in 1:n) { k <- m - M[i] if (justify == "left") { S[i] <- paste(s[i], blanks(k), sep = "", collapse="") } else if (justify == "right") { S[i] <- paste(blanks(k), s[i], sep = "", collapse="") } else { # justify == "center" kl <- k %/% 2 kr <- k - kl S[i] <- paste(blanks(kl), s[i], blanks(kr), sep = "", collapse="") } } return(S) } strRep <- function(s, old, new) { # Find and replace substring if (! is.character(s)) stop("Argument 's' must be a character vector.") if (!is.character(old) || !is.character(new) || length(old) != 1 || length(new) != 1) stop("Arguments 'old' and 'new' must be simple character strings.") gsub(old, new, s, fixed = TRUE) } pracma/R/quadl.R0000644000176200001440000000564011600712273013153 0ustar liggesusers## ## q u a d l . R Adaptive Simpson Quadrature ## quadl <- function(f, xa, xb, tol = .Machine$double.eps^0.5, trace = FALSE, ...) { stopifnot(is.numeric(xa), length(xa) == 1, is.finite(xa), is.numeric(xb), length(xb) == 1, is.finite(xb)) fun <- match.fun(f) f <- function(x) fun(x, ...) if (xa == xb) return(xb-xa) else if (xa > xb) { tmp <- xa; xa <- xb; xb <- tmp rev_p <- TRUE } else rev_p <- FALSE eps <- .Machine$double.eps if (!is.finite(f(xa))) xa <- xa + 2*eps if (!is.finite(f(xb))) xb <- xb - 2*eps Q <- .adaptlob(f, xa, xb, tol, trace) if (rev_p) Q <- -1 * Q return(Q) } .adaptlob <- function(f, a, b, tol = tol, trace = trace) { m <- (a+b)/2 h <- (b-a)/2 alpha <- sqrt(2/3) beta <- 1/sqrt(5) x1 <- 0.942882415695480 x2 <- 0.641853342345781 x3 <- 0.236383199662150 x <- c(a, m-x1*h, m-alpha*h, m-x2*h, m-beta*h, m-x3*h, m, m+x3*h, m+beta*h, m+x2*h, m+alpha*h, m+x1*h, b) y <- f(x) fa <- y[1] fb <- y[13] i2 <- (h/6) * (y[1] + y[13] + 5*(y[5]+y[9])) i1 <- (h/1470) * (77*(y[1]+y[13]) + 432*(y[3]+y[11]) + 625*(y[5]+y[9]) + 672*y[7]) ab <- h * (0.0158271919734802 * (y[1]+y[13]) + 0.0942738402188500 * (y[2]+y[12]) + 0.155071987336585 * (y[3]+y[11]) + 0.188821573960182 * (y[4]+y[10]) + 0.199773405226859 * (y[5]+y[9]) + 0.224926465333340 * (y[6]+y[8]) + 0.242611071901408 * y[7]) s <- sign(ab) if (s == 0) s <- 1 erri1 <- abs(i1-ab) erri2 <- abs(i2-ab) R <- 1 if (erri2 != 0) R <- erri1/erri2 if (R > 0 && R < 1) tol <- tol/R ab <- s * abs(ab) * tol/.Machine$double.eps if (ab == 0) ab <- b-a Q <- .adaptlobstp(f, a, b, fa, fb, ab, trace) } .adaptlobstp <- function(f, a, b, fa, fb, ab, trace) { h <- (b-a)/2 m <- (a+b)/2 alpha <- sqrt(2/3) beta <- 1/sqrt(5) mll <- m - alpha*h ml <- m - beta*h mr <- m + beta*h mrr <- m + alpha*h x <- c(mll, ml, m, mr, mrr) y <- f(x) fmll <- y[1] fml <- y[2] fm <- y[3] fmr <- y[4] fmrr <- y[5] i2 <- (h/6) * (fa + fb + 5*(fml+fmr)) i1 <- (h/1470) * (77*(fa+fb) + 432*(fmll+fmrr) + 625*(fml+fmr) + 672*fm) if ( ab+(i1-i2) == ab | mll <= a | b <= mrr ) { if ( (m <= a || b <= m) ) warning("Required tolerance may not be met.") Q <- i1 if (trace) cat(a, b-a, Q, "\n") } else { Q <- .adaptlobstp(f, a, mll, fa, fmll, ab, trace) + .adaptlobstp(f, mll, ml, fmll, fml, ab, trace) + .adaptlobstp(f, ml, m, fml, fm, ab, trace) + .adaptlobstp(f, m, mr, fm, fmr, ab, trace) + .adaptlobstp(f, mr, mrr, fmr, fmrr, ab, trace) + .adaptlobstp(f, mrr, b, fmrr, fb, ab, trace) } return(Q) } pracma/R/factors.R0000755000176200001440000000111612031005021013464 0ustar liggesusers### ### f a c t o r s . R Factorize natural number ### factors <- function(n) { if (!is.numeric(n) || length(n) != 1 || n != round(n) || n < 1) stop("Argument 'n' must be a nonnegative integer.") if (n >= 2^53) stop("Argument 'n' must not be larger than 2^53-1.") if (n < 4) return(n) f <- c() p <- primes(sqrt(n)) d <- which(n %% p == 0) if (length(d) == 0) return(n) # n is prime for (q in p[d]) { while (n %% q == 0) { f <- c(f, q) n <- n/q } } if (n > 1) f <- c(f, n) return(f) } pracma/R/conv.R0000644000176200001440000000103212074770002013001 0ustar liggesusers## ## c o n v . R Polynomial Convolution ## conv <- function(x, y) { if ( (!is.vector(x, mode="numeric") && !is.vector(x, mode="complex")) || (!is.vector(y, mode="numeric") && !is.vector(y, mode="complex")) ) stop("Arguments 'x' and 'y' must be real or complex vectors.") lx <- length(x) ly <- length(y) n <- lx + ly - 1 z <- fft(fft(c(x, rep(0, n - lx))) * fft(c(y, rep(0, n - ly))), inverse = TRUE) / n if (is.numeric(x) && is.numeric(y)) z <- Re(z) return(z) } pracma/R/polynomials.R0000644000176200001440000001255113470770406014423 0ustar liggesusers## ## p o l y n o m i a l s . R Polynomial Functions ## # Generate a polynomial from its roots Poly <- function(x) { if (is.null(x) || length(x) == 0) return(c(1)) if (is.vector(x, mode="numeric") || is.vector(x, mode="complex")) { y <- x } else { if ((is.numeric(x) || is.complex(x)) && is.matrix(x)) { y <- eigen(x)$values } else { stop("Argument 'x' must be a vector or square matrix.") } } n <- length(y) p <- c(1, rep(0, n)) for (i in 1:n) { p[2:(i+1)] <- p[2:(i+1)] - y[i] * p[1:i] } if (all(Im(p) == 0)) p <- Re(p) return(p) } # Add (and subtract) polynomials polyadd <- function(p, q){ if ( (!is.vector(p, mode="numeric") && !is.vector(p, mode="complex")) || (!is.vector(q, mode="numeric") && !is.vector(q, mode="complex")) ) stop("Arguments 'p' and 'q' must be real or complex vectors.") lp <- length(p) lq <- length(q) if (lp >= lq) { r <- p + c(numeric(lp-lq), q) } else { r <- q + c(numeric(lq-lp), p) } lr <- length(r) while (r[1] == 0 && lr > 1) { r <- r[2:lr] lr <- lr - 1 } return(r) } # Multiply polynomials polymul <- function(p, q){ if ( (!is.vector(p, mode="numeric") && !is.vector(p, mode="complex")) || (!is.vector(q, mode="numeric") && !is.vector(q, mode="complex")) ) stop("Arguments 'p' and 'q' must be real or complex vectors.") n <- length(p); m <- length(q) if (n <= 1 || m <= 1) return(p*q) r <- rep(0, n+m-1) for (i in seq(along=q)) { r <- r + c(rep(0, i-1), p * q[i], rep(0, m-i)) } while (r[1] == 0 && length(r) > 1) r <- r[2:length(r)] return(r) } # Take powers of polynomials polypow <- function(p, n){ if ( !is.vector(p, mode="numeric") && !is.vector(p, mode="complex") ) stop("Arguments 'p' must be a real or complex vector.") if ( !is.numeric(n) || length(n) != 1 || floor(n) != ceiling(n) || n < 0 ) stop("Argument 'n' must be a non-negative integer.") pp <- c(1) while (n > 0) { pp <- polymul(pp, p) n <- n - 1 } return(pp) } # Divide polynomials using the 'deconv' function polydiv <- function(p, q) { if (length(q) == 1) return(list(d = p/q, r = 0)) qr <- deconv(p,q) d <- zapsmall(qr$q); r <- zapsmall(qr$r) return(list(d = d, r = r)) } # 'Symbolic' derivative of a polynomial polyder <- function(p, q) { if (!missing(q)) { if (length(q) == 0) return(0) if (!is.numeric(q) && !is.complex(q)) stop("Arguments must be real or complex vectors or matrices.") m <- length(q) if (is.matrix(q)) q <- q[1:m] } else { q <- 1; m <- 1 } if (length(p) == 0) return(0) if (!is.numeric(p) && !is.complex(p)) stop("Argument 'p' must be a real or complex vector or matrix.") n <- length(p) if (is.matrix(p)) p <- p[1:n] # multiply polynomials p an q if (n*m <= 1) { return(0) } else { r <- rep(0, n+m-1) for (i in seq(along=q)) { r <- r + c(rep(0, i-1), p * q[i], rep(0, m-i)) } } # case k > 1 k <- length(r) r <- c((k-1):1) * r[1:(k-1)] while (r[1] == 0 && length(r) >= 2) { r <- r[2:length(r)] } return(r) } # 'Symbolic' antiderivative of a polynomial polyint <- function(p, k=0) { if (length(p) == 0) return(c()) if (!is.vector(p, mode="numeric") && !is.vector(p, mode="complex")) stop("Argument 'p' must be a real or complex vector.") if (!is.vector(k, mode="numeric") && !is.vector(k, mode="complex")) stop("Argument 'k' must be a real or complex vector") return( c(p / (length(p):1), k) ) } # Transform a polynomial with another polynomial polytrans <- function(p, q){ if ( (!is.vector(p, mode="numeric") && !is.vector(p, mode="complex")) || (!is.vector(q, mode="numeric") && !is.vector(q, mode="complex")) ) stop("Arguments 'p' and 'q' must be real or complex vectors.") n <- length(p) if (length(p) == 1) return(p) pt <- 0 for (i in 1:n) { pt <- polyadd(pt, p[i]*polypow(q, n-i)) } return(pt) } # Print polynomial in normal form (highest powers first) poly2str <- function(p, svar = "x", smul = "*", d = options("digits")$digits) { if (length(p) == 0) return("") if (is.complex(p)) stop("Printing of complex coefficients not yet implemented.") else if (!is.numeric(p)) stop("Argument 'p' must be a numeric vector.") while (p[1] == 0 && length(p) > 1) p <- p[2:length(p)] if (length(p) == 1) return(as.character(p)) s <- sign(p) p <- abs(p) p <- formatC(p, digits = d) p <- sub("^\\s+", "", p) n <- length(p) - 1 S <- "" s1 <- if (s[1] == 1) "" else "-" S <- paste(s1, p[1], smul, svar, "^", n, sep = "") for (i in 2:(n+1)) { if (s[i] == 1) s1 <- " + " else if (s[i] == -1) s1 <- " - " else next if (n-i+1 > 1) { S <- paste(S, s1, p[i], smul, svar, "^", n-i+1, sep="") } else if (i == n) { S <- paste(S, s1, p[i], smul, svar, sep="") } else { S <- paste(S, s1, p[i], sep="") } } return(S) } pracma/R/fractalcurve.R0000644000176200001440000000522512660202404014522 0ustar liggesusers## ## f r a c t a l c u r v e . R Fractal curves ## fractalcurve <- function(n, which = c("hilbert", "sierpinski", "snowflake", "dragon", "triangle", "arrowhead", "flowsnake", "molecule")) { curve <- match.arg(which) if (curve == "hilbert") { # Hilbert curve a <- 1 + 1i b <- 1 - 1i z <- 0 for (k in 1:n) { w <- 1i * Conj(z) z <- c(w-a, z-b, z+a, b-w) / 2.0 } } else if (curve == "sierpinski") { # Sierpinski Cross curve a <- 1 + 1i b <- 1 - 1i c <- 2 - sqrt(2) z <- c for (k in 1:n) { w <- 1i * z z <- c(z+b, w+b, a-w, z+a) / 2.0 } z <- c(z, 1i*z, -z, -1i*z, z[1]) } else if (curve == "snowflake") { # Koch snowflake a <- 1/2 + sqrt(-3+0i)/6; b <- 1 - a c <- 1/2 + sqrt(-3+0i)/2; d <- 1 - c z <- 1 for (k in 1:n) { z <- Conj(z) z <- c(a*z, b*z+a) } z <- c(0, z, 1-c*z, 1-c-d*z) } else if (curve == "dragon") { # Dragon curve a <- (1 + 1i)/2 b <- (1 - 1i)/2 c <- sqrt(1/2 + 0i) z <- c(1-c, c) for (k in 1:n) { w <- rev(z) # z(end:-1:1); z <- c(a*z, 1-b*w) } } else if (curve == "triangle") { # Sierpinski Triangle curve a <- (1 + sqrt(-3+0i))/2 z <- c(0, 1) for (k in 1:n) { z <- c(z, z+a, z+1)/2 } z <- c(z, a, 0) } else if (curve == "arrowhead") { # Sierpinski Arrowhead curve a <- (1 + sqrt(-3+0i))/2 b <- (1 - sqrt(-3+0i))/2 z <- 0 for (k in 1:n) { w <- Conj(z) z <- c(a*w, z+a, b*w+a+1)/2 } z <- c(z, 1) } else if (curve == "flowsnake") { # Gosper Flowsnake curve a <- (1 + sqrt(-3+0i))/2 b <- (1 - sqrt(-3+0i))/2 c <- c(1, a, -b, -1, -a, b) u = 0; for (k in 1:n) { v <- rev(u) u <- c(u, v+1, v+3, u+2, u, u, v-1) } u <- mod(u, 6) z <- cumsum(c[u+1]) z <- c(0, z/7^(n/2)) } else if (curve == "molecule") { # Hexagon Molecule curve a <- (1 + sqrt(-3+0i))/2 b <- (1 - sqrt(-3+0i))/2 c <- c(1, a, -b, -1, -a, b) u <- 0 for (k in 1:n) { u <- c(u+1, -u, u-1) } u <- c(u, 1-u, 2+u, 3-u, 4+u, 5-u) u <- mod(u, 6) z <- cumsum(c[u+1]) z <- c(0, z/2^n) } else { stop("Unknown fractal curve name ...") } return(list(x = Re(z), y = Im(z))) } pracma/R/humps.R0000644000176200001440000000076613034767277013226 0ustar liggesusers## ## h u m p s . R Matlab Test Function ## humps <- function(x) { if (missing(x)) x <- seq(0.0, 1.0, by=0.05) stopifnot(is.numeric(x)) 1/((x-0.3)^2 + 0.01) + 1/((x-0.9)^2 + 0.04) - 6 } sinc <- function(x) { stopifnot(is.numeric(x)) sin(pi * x) / (pi * x) } psinc <- function(x, n) { stopifnot(is.numeric(x), is.numeric(n)) if (floor(n) != ceiling(n) || n < 1) stop("Argument 'n' must be a positive integer.") sin(x * n/2) / n * sin(x/2) } pracma/R/hampel.R0000755000176200001440000000134711705017176013324 0ustar liggesusers## ## h a m p e l . R MAD Outlier in Time Series ## hampel <- function (x, k, t0 = 3) { # x: vector or time series # k: window [x_(i-k),...,x_i,...,x_(i+k)] n <- length(x) y <- x # corrected x vector ind <- c() # indices of outliers L <- 1.4826 # constants for normal distributions # t0 <- 3 # Pearson's 3 sigma edit rule # we don't look at outliers at the end parts of x ! for ( i in (k+1):(n-k) ) { x0 <- median( x[(i-k):(i+k)] ) S0 <- L * median( abs(x[(i-k):(i+k)] - x0) ) if ( abs(x[i]-x0) > t0 * S0 ) { y[i] <- x0 ind <- c(ind, i) } } # return a list with 2 components list(y=y, ind=ind) } pracma/R/pp.R0000644000176200001440000000167411732414441012471 0ustar liggesusers## ## p p . R Piecewise Polynomial Structures ## mkpp <- function(x, P) { stopifnot(is.numeric(x), is.numeric(P)) if (!is.vector(x) || is.unsorted(x)) stop("Argument 'x' must be a sorted, finite numeric vector.") lx <- length(x) n <- nrow(P); m <- ncol(P) if (lx != n+1) stop("Length of 'x' must be equal to 'nrow(P)+1'.") pp <- list(breaks = x, coefs = P, pieces = n, order = m, dim = 1) class(pp) <- "pp" return(pp) } ppval <- function(pp, xx) { stopifnot(is.numeric(xx), any(!is.na(xx))) if (!class(pp) == "pp") stop("Argument 'pp' must be piecewise polynomial structure.") lx <- length(xx); yy <- rep(NA, lx) xb <- pp$breaks; lb <- length(xb) inds <- findInterval(xx, xb) inds[inds == 0] <- 1 inds[inds == lb] <- lb - 1 for (i in 1:(lb-1)) { js <- which(inds == i) yy[js] <- polyval(pp$coefs[i, ], xx[js] - xb[i]) } return(yy) } pracma/R/shooting.R0000644000176200001440000000206313024246505013675 0ustar liggesusersshooting <- function(f, t0, tfinal, y0, h, a, b, itermax = 20, tol = 1e-6, hmax = 0) { stopifnot(is.numeric(y0), length(y0) == 1, is.numeric(t0), length(t0) == 1, is.numeric(tfinal), length(tfinal) == 1, is.numeric(a), length(a) == 1, is.numeric(b), length(b) == 1) fun <- match.fun(f) ff <- function(t, y) matrix( c(y[2], fun(t, y[1], y[2])) ) hun <- match.fun(h) hh <- function(u, v) hun(u, v) dy <- numeric(itermax); dy[1:2] <- c(a, b) m <- numeric(itermax) test <- 1; i <- 1 while (test > tol && i <= itermax) { if (i > 2) dy[i] <- dy[i-1] - (dy[i-1]-dy[i-2]) * m[i-1] / (m[i-1]-m[i-2]) z0 <- matrix(c(y0, dy[i])) sol <- ode45(ff, t0, tfinal, z0, atol = tol, hmax = hmax) Tsol <- sol$t; Ysol <- sol$y n <- length(Tsol) yend <- Ysol[n, 1]; ypend <- Ysol[n, 2] m[i] <- h(yend, ypend) test <- abs(m[i]) i <- i+1 } return(list(t = Tsol, y = Ysol)) } pracma/R/quad2d.R0000644000176200001440000000126711600712273013226 0ustar liggesusers## ## q u a d 2 d . R and q u a d v .R ## quad2d <- function(f, xa, xb, ya, yb, n = 32, ...) { stopifnot(is.numeric(xa), length(xa) == 1, is.numeric(ya), length(ya) == 1, is.numeric(xb), length(xb) == 1, is.numeric(yb), length(yb) == 1) fun <- match.fun(f) f <- function(x, y) fun(x, y, ...) # Get Gauss-Legendre nodes and weights in x- and y-direction. cx <- gaussLegendre(n, xa, xb) x <- cx$x wx <- cx$w cy <- gaussLegendre(n, ya, yb) y <- cy$x wy <- cy$w # Compute function f at all nodes in x- and y-direction mgrid <- meshgrid(x, y) Z <- f(mgrid$X, mgrid$Y) Q <- wx %*% Z %*% as.matrix(wy) return(Q[,]) } pracma/R/histc.R0000644000176200001440000000372612146466630013173 0ustar liggesusers## ## h i s t c . R Histogram Count ## histc <- function(x, edges) { stopifnot(is.numeric(x), is.numeric(edges)) edges <- c(edges) n <- length(edges) if (is.unsorted(edges)) stop("Argument 'edges' must be a monotonically non-decreasing vector.") if (length(edges) == 1) { bin <- numeric(length(x)) if (is.matrix(x)) dim(bin) <- c(n, ncol(x)) return(list(cnt = 0, bin = bin)) } bin <- numeric(length(x)) if (is.vector(x)) { cnt <- numeric(n) for (i in 1:(n-1)) { li <- edges[i] <= x & x < edges[i+1] cnt[i] <- sum(li) bin[li] <- i } li <- x == edges[n] cnt[n] <- sum(li) bin[li] <- n } else if (is.matrix(x)) { cnt <- matrix(0, n, ncol(x)) for (i in 1:(n-1)) { li <- edges[i] <= x & x < edges[i+1] cnt[i, ] <- apply(li, 2, sum) bin[li] <- i } li <- x == edges[n] cnt[n, ] <- apply(li, 2, sum) bin[li] <- n } else { stop("Argument 'x' must be a numeric vector or matrix.") } dim(bin) <- dim(x) return(list(cnt = cnt, bin = bin)) } histss <- function(x, n = 100, plotting = FALSE) { stopifnot(is.numeric(x), is.numeric(n)) x <- c(x) if (length(n) > 1 || n < 2 || floor(n) != ceiling(n)) stop("Argument 'n' must be an integer greater than 1.") D <- C <- numeric(n-1) for (i in 1:(n-1)) { D[i] <- diff(range(x)) / (i+1) E <- seq(min(x), max(x), length.out = i+1) hp <- hist(x, breaks = E, plot = FALSE) ki <- hp$counts k <- mean(ki) v <- sum((ki-k)^2) / (i+1) C[i] <- (2*k - v) / D[i]^2 # cost function } idx <- which.min(C) optD <- D[idx] E <- seq(min(x), max(x), length = idx+1) h <- hist(x, breaks = E, plot = plotting) # rug(x) if (plotting) invisible(h) else return(h) } pracma/R/taylor.R0000644000176200001440000000135212105737273013363 0ustar liggesusers## ## t a y l o r . R Taylor Series Approximation ## taylor <- function(f, x0, n = 4, ...) { if (!is.numeric(x0)) stop("Argument 'x0' must be a numeric value or vector.") if (!is.numeric(n) || floor(n) != ceil(n) || length(n) != 1) stop("Order 'n' must be an scalar integer between 1 and 8.") fun <- match.fun(f) f <- function(x) fun(x, ...) if (n > 8) { # n <- 8 warning("Order 'n' is too high; should not be greater than 'n=8'.") } else if (n <= 0) { n <- 4 warning("Order 'n' is too low; will be reset to the default 'n=4'.") } T <- f(x0) for (i in 1:n) { T <- polyadd(T, fderiv(f, x0, i)/fact(i) * polypow(c(1, -x0), i)) } return(T) } pracma/R/moler.R0000644000176200001440000000042212030655336013160 0ustar liggesusers## ## m o l e r . R ## moler <- function(n) { if (length(n) != 1 || n != round(n)) stop("Argument 'n' must be an integer.") if (n <= 0) return(c()) A <- matrix(0, nrow = n, ncol = n) for (i in 1:n) { A[i, 1:i] <- (1:i) - 2 } A <- A + t(A) diag(A) <- 1:n A } pracma/R/polyfit.R0000755000176200001440000000530612722564044013544 0ustar liggesusers### ### p o l y f i t . R Polynom ### polyfit <- function(x, y, n = 1) { if (!is.numeric(x) || !is.numeric(y)) stop("Arguments x and y must be numeric.") if (length(x) != length(y)) stop("Vectors/matrices x and y must be of same length.") if (is.null(n) || n < 0 || ceiling(n) != floor(n)) stop("Degree n must be a non-negative integer.") x <- x[1:length(x)]; y <- y[1:length(y)] A <- outer(x, seq(n, 0), "^") p <- qr.solve(A, y) return(p) } polyfix <- function(x, y, n, xfix, yfix) { stopifnot(is.numeric(x), is.numeric(y), is.numeric(xfix), is.numeric(yfix)) nfit = length(x) if (length(y) != nfit) stop("Arguments 'x' and 'y' must have the same length.") nfix = length(xfix) if (length(yfix) != nfix) stop("Arguments 'xfix' and 'yfix' must have the same length.") if (!is.numeric(n) || n < 0 || floor(n) != ceiling(n)) stop("Argument 'n' must be an integer.") if (n < nfix-1) { stop("Argument 'n' shall be greater or equal to 'nfix-1'.") } else if (n == nfix-1) { warning("Data points can not be taken into account.") return(polyfit(xfix, yfix, n)) } A <- ones(nfix, n+1) for (i in 1:(n+1)) A[, i] <- ones(nfix, 1) * xfix^(n+1-i) pc <- qr.solve(A[,(n+2-nfix):ncol(A)], yfix) # Satifies A*pc = yfix pcfull <- matrix(0, n+1, 1) pcfull[(n+2-nfix):(n+1)] <- pc yfit <- y - polyval(pc, x) B <- nullspace(A) X <- matrix(0, nfit,n+1) for(i in 1:(n+1)) X[, i] <- matrix(1, nfit,1) * x^(n+1-i) z = qr.solve(X %*% B, yfit) # Least squares solution of X*B*z = yfit p0 <- B %*% z # Satisfies A*p0 = 0 p <- p0 + pcfull # Satisfies A*p = b return(c(p)) } # polyfit2 <- function(x, y, n = 1, p0 = NULL) { # if (!is.numeric(x) || !is.numeric(y)) # stop("Arguments 'x' and 'y' must be numeric.") # if (length(x) != length(y)) # stop("Vectors/matrices 'x' and 'y' must be of same length.") # if (is.null(n) || n <= 0 || ceiling(n) != floor(n)) # stop("Argument 'n', order of fit, must be a positive integer.") # if (is.null(p0)) # return(polyfit(x, y, n = n)) # else if (!is.numeric(p0) || length(p0) != 2) # stop("Argument 'p0' must be a numeric vector of length 2.") # # x0 <- p0[1]; y0 <- p0[2] # xx <- x - x0; yy <- y - y0 # # M <- matrix(0, length(x), n) # M[, n] <- xx # for (i in (n-1):1) { # M[, i] <- xx * M[, i+1] # } # pt <- qr.solve(M, yy) # pt <- c(pt, y0) # p <- numeric(n+1) # for (i in (n+1):1) { # p[i] <- polyval(pt, -x0) # pt <- polyder(pt)/(n-i+2) # } # return(p) # } pracma/R/clenshaw_curtis.R0000644000176200001440000000140012416301201015217 0ustar liggesusers## ## q u a d c c . R Clenshaw-Curtis Quadrature ## clenshaw_curtis <- function(f, a = -1, b = 1, n = 1024, ...) { fun <- match.fun(f) f <- function(x) fun(x, ...) if (a == b) return(0) eps <- .Machine$double.eps # assume a < b if (!is.finite(f(a))) a <- a + eps * sign(b-a) if (!is.finite(f(b))) b <- b - eps * sign(b-a) # Evaluate f at Chebyshev points x <- cos(pi*(0:n)/n) fx <- f(0.5*((b-a)*x + (b+a)))/(2*n) # Fast Fourier transform g <- Re(fft(fx[c(1:(n+1), n:2)])) # Chebyshev coefficients and weight vector d <- c(g[1], g[2:n] + g[(2*n):(n+2)], g[n+1]) w <- 0 * d w[seq(1, n+1, by=2)] <- 2/(1-(seq(0, n, by=2))^2) # Return the integral Q <- sum(w * d) * (b-a)/2 return(Q) } pracma/R/ezplot.R0000644000176200001440000001040313160511452013352 0ustar liggesusers## ## e z p l o t . R ## fplot <- function(f, interval, ...) { stopifnot(is.numeric(interval), length(interval) == 2) a <- interval[1]; b <- interval[2] ezplot(f, a, b, main = "", ...) } ezplot <- function(f, a, b, n = 101, col = "blue", add = FALSE, lty = 1, lwd = 1, marker = 0, pch = 1, grid = TRUE, gridcol = "gray", fill = FALSE, fillcol = "lightgray", xlab = "x", ylab = "f (x)", main = "Function Plot", ...) { fun <- match.fun(f) f <- function(x) fun(x) stopifnot(is.numeric(a), is.numeric(b), length(a) == 1, length(b) == 1, a < b) x <- seq(a, b, length.out = n) y <- f(x) if (!add) plot(x, y, type = "n", xlab = xlab, ylab = ylab, main = main, ...) if (grid) grid(col = gridcol) if (fill) { xx <- c(x, rev(x)) yy <- c(rep(0, length(x)), rev(y)) polygon(xx, yy, col = fillcol, border = "darkgray") } lines(x, y, col = col, lty = lty, lwd = lwd) if (marker > 0) { m <- min(max(marker, 3), n %/% 3) d <- c(0, sqrt(diff(x)^2 + diff(y)^2)) cs <- cumsum(d) s <- cs[n] # sum(d) l <- s / (m-1) inds <- numeric(m) inds[c(1, m)] <- c(1, n) for (k in 2:(m-1)) inds[k] <- which.min(abs(cs - (k-1)*l)) points(x[inds], y[inds], col = col, pch = pch) } invisible(NULL) } ezcontour <- function(f, xlim = c(-pi,pi), ylim = c(-pi,pi), n = 60, filled = FALSE, col = NULL) { fun <- match.fun(f) f <- function(x) fun(x) stopifnot(is.numeric(xlim), is.numeric(ylim), length(xlim) == 2, length(ylim) == 2, xlim[1] < xlim[2], ylim[1] < ylim[2]) xx <- linspace(xlim[1], xlim[2], n) yy <- linspace(ylim[1], ylim[2], n) F <- matrix(NA, n, n) for (i in 1:n) { for (j in 1:n) { F[i, j] <- f(c(xx[i], yy[j])) } } if (filled) { if (is.null(col)) col <- heat.colors(12) image(xx, yy, F, col = col) contour(xx, yy, F, add = TRUE) } else { if (is.null(col)) col <- "black" contour(xx, yy, F) grid() } invisible(NULL) } ezsurf <- function (f, xlim = c(-pi, pi), ylim = c(-pi, pi), n = 60, ...) { fun <- match.fun(f) f <- function(x) fun(x) stopifnot(is.numeric(xlim), is.numeric(ylim), length(xlim) == 2, length(ylim) == 2, xlim[1] < xlim[2], ylim[1] < ylim[2]) x <- linspace(xlim[1], xlim[2], n) y <- linspace(ylim[1], ylim[2], n) # z <- outer(xx, yy, f) z <- matrix(NA, n, n) for (i in 1:n) { for (j in 1:n) { z[i, j] <- f(c(x[i], y[j])) } } # interpolating colors in the range of specified colors nbcol <- 100 # jet.colors <- colorRampPalette( c("blue", "yellow") ) # colors <- jet.colors(nbcol) colors <- topo.colors(nbcol) # Compute the z-value at the facet centres zfacet <- z[-1, -1] + z[-1, -n] + z[-n, -1] + z[-n, -n] facetcol <- cut(zfacet, nbcol) persp(x, y, z, col = colors[facetcol], border = "grey50", ...) invisible(NULL) } ezmesh <- function(f, xlim = c(-pi,pi), ylim = c(-pi,pi), n = 60, ...) { fun <- match.fun(f) f <- function(x) fun(x) stopifnot(is.numeric(xlim), is.numeric(ylim), length(xlim) == 2, length(ylim) == 2, xlim[1] < xlim[2], ylim[1] < ylim[2]) x <- linspace(xlim[1], xlim[2], n) y <- linspace(ylim[1], ylim[2], n) z <- matrix(NA, n, n) for (i in 1:n) { for (j in 1:n) { z[i, j] <- f(c(x[i], y[j])) } } persp(x, y, z, col = "yellow", border = "grey50", ...) invisible(NULL) } ezpolar <- function(fun, interv = c(0, 2*pi)) { stopifnot(is.numeric(interv)) if (length(interv) != 2 || interv[1] >= interv[2]) stop("Argument 'interv' must have two elements [a, b] with a < b.") n <- 91 x <- seq(interv[1], interv[2], length.out = n) y <- fun(x) if (length(y) != n) { warning("Function 'fun' not vectorized: will do that for you.") y <- numeric(n) for (i in 1:n) y[i] <- fun(x[i]) } polar(x, y) invisible(NULL) } pracma/R/procrustes.R0000644000176200001440000000405412053365262014261 0ustar liggesusers## ## p r o c r u s t e s . R Procrustes Problem ## procrustes <- function(A, B) { stopifnot(is.numeric(A), is.numeric(B)) if (!is.matrix(A) || !is.matrix(B)) stop("Arguments 'A' and 'B' must be numeric matrices.") if (any(dim(A) != dim(B))) stop("Matrices 'A' and 'B' must be of the same size.") C <- t(B) %*% A Svd <- svd(C) # singular value decomposition U <- Svd$u S <- diag(Svd$d) V <- Svd$v Q <- U %*% t(V) P <- B %*% Q R <- A - P; r <- sqrt(Trace(t(R) %*% R)) # Frobenius norm: Norm(A - P) return(list(P = P, Q = Q, d = r)) } kabsch <- function(A, B, w = NULL) { stopifnot(is.numeric(A), is.numeric(B)) if ( !is.matrix(A) || !is.matrix(B) ) stop("Arguments 'A' and 'B' must be numeric matrices.") if ( any(dim(A) != dim(B)) ) stop("Matrices 'A' and 'B' must be of the same size.") D <- nrow(A) # space dimension N <- ncol(A) # number of points if (is.null(w)) { w <- matrix(1/N, nrow = N, ncol = 1) # weights as column vector } else { if (!is.numeric(w) || length(w) != N) stop("Argument 'w' must be a (column) vector of length ncol(A).") } p0 <- A %*% w # the centroid of A q0 <- B %*% w # the centroid of B v1 <- ones(1,N) # row vector of N ones A <- A - p0 %*% v1 # translating A to center the origin B <- B - q0 %*% v1 # translating B to center the origin Pdm <- zeros(D,N) for (i in 1:N) Pdm[, i] <- w[i] * A[, i] C <- Pdm %*% t(B) Svd <- svd(C) # singular value decomposition V <- Svd$u S <- diag(Svd$d) W <- Svd$v I <- eye(D) # more numerically stable than using (det(C) < 0) if (det(V %*% t(W)) < 0) I[D, D] <- -1 U <- W %*% I %*% t(V) R <- q0 - U %*% p0 Diff <- U %*% A - B # A, B already centered lrms <- 0 for (i in 1:N) lrms <- lrms + w[i] * t(Diff[, i]) %*% Diff[, i] lrms <- sqrt(lrms) return(list(U = U, R = R, d = lrms)) } pracma/R/bernstein.R0000644000176200001440000000210013121271145014020 0ustar liggesusersbernstein <- function(f, n, x) { stopifnot(is.function(f), is.numeric(n), is.numeric(x)) if (floor(n) != ceiling(n) || n < 0) stop("Argument 'n' must be a nonnegative integer.") if (any(x < -1.0 || x > 1.0)) stop("Elements of argument 'x' must all lie in [0, 1].") if (length(x) == 1) { b2 <- f((0:n)/n) for (j in 1:n) { b1 <- b2 b2[1:(n-j+1)] <- b1[1:(n-j+1)] * (1-x) + b1[2:(n-j+2)] * x } b <- b2[1] } else { b <- 0 for (k in 0:n) { b <- b + choose(n,k) * x^k * (1-x)^(n-k) * f(k/n) } } return(b) } bernsteinb<- function(k, n, x) { stopifnot(is.numeric(k), is.numeric(n), is.numeric(x)) if (floor(n) != ceiling(n) || n < 0) stop("Argument 'n' must be a nonnegative integer.") if (floor(k) != ceiling(k) || k < 0 || k > n) stop("Argument 'k' must be an integer between 0 and 'n'.") if (any(x < -1.0 || x > 1.0)) stop("Elements of argument 'x' must all lie in [0, 1].") choose(n,k) * x^k * (1-x)^(n-k) } pracma/R/dblquad.R0000644000176200001440000000642512172306455013471 0ustar liggesusers## ## d b l q u a d . R Double Integration ## dblquad <- function(f, xa, xb, ya, yb, dim = 2, ..., subdivs = 300, tol = .Machine$double.eps^0.5) { stopifnot(is.numeric(xa), length(xa) == 1, is.numeric(xb), length(xb) == 1, is.numeric(ya), length(ya) == 1, is.numeric(yb), length(yb) == 1) fun <- match.fun(f) f <- function(x, y) fun(x, y, ...) if (length(f(c(xa, xb), c(ya, yb))) != 2) stop("Function 'f' does not appear to be vectorized.") if (dim == 2) { fy <- function(x) integrate(function(y) f(x, y), ya, yb, subdivisions = subdivs, rel.tol = tol)$value Fy <- Vectorize(fy) Q <- integrate(Fy, xa, xb, subdivisions = subdivs, rel.tol = tol)$value } else if (dim == 1) { fx <- function(y) integrate(function(x) f(x, y), xa, xb, subdivisions = subdivs, rel.tol = tol)$value Fx <- Vectorize(fx) Q <- integrate(Fx, ya, yb, subdivisions = subdivs, rel.tol = 10*tol)$value } else stop("Argument 'dim' can only be 1 (x-) or 2 (y-variable first).") return(Q) } triplequad <- function(f, xa, xb, ya, yb, za, zb, subdivs = 300, tol = .Machine$double.eps^0.5, ...) { stopifnot(is.numeric(xa), length(xa) == 1, is.numeric(xb), length(xb) == 1, is.numeric(ya), length(ya) == 1, is.numeric(yb), length(yb) == 1, is.numeric(za), length(za) == 1, is.numeric(zb), length(zb) == 1) fun <- match.fun(f) f <- function(x, y, z) fun(x, y, z, ...) fyz <- function(y, z) { Qin <- numeric(length(y)) for (i in 1:length(y)) { fx <- function(x) f(x, y[i], z[i]) Qin <- integrate(fx, xa, xb, subdivisions = subdivs, rel.tol = 1e-10)$value } Qin } fyz <- Vectorize(fyz) dblquad(fyz, ya, yb, za, zb, tol = tol) } simpson2d <- function(f, xa, xb, ya, yb, nx = 128, ny = 128, ...) { stopifnot(is.numeric(xa), length(xa) == 1, is.numeric(xb), length(xb) == 1, is.numeric(ya), length(ya) == 1, is.numeric(yb), length(yb) == 1) fun <- match.fun(f) f <- function(x, y) fun(x, y, ...) if (nx %% 2 != 0) nx <- nx + 1 if (ny %% 2 != 0) ny <- ny + 1 # Grid and grid vectors hx <- (xb - xa) / nx hy <- (yb - ya) / ny xg <- seq(xa, xb, by = hx) yg <- seq(ya, yb, by = hy) # Interchange meshgrid mgrid <- meshgrid(yg, xg) X <- mgrid$Y Y <- mgrid$X F <- f(X, Y) # Contributions from the corner points s1 <- F[1, 1] + F[1, ny+1] + F[nx+1, 1] + F[nx+1, ny+1] # Contributions from other edge points ixo <- seq(2, nx, by = 2); ixe <- seq(3, nx-1, by = 2) iyo <- seq(2, ny, by = 2); iye <- seq(3, ny-1, by = 2) s2 <- 2 * ( sum(F[1, iye]) + sum(F[nx+1, iye]) + sum(F[ixe, 1]) + sum(F[ixe, ny+1]) ); s3 <- 4 * ( sum(F[1, iyo]) + sum(F[nx+1, iyo]) + sum(F[ixo, 1]) + sum(F[ixo, ny+1]) ); # Contributions from interior points s4 <- 16 * sum( sum( F[ixo,iyo] ) ) + 4 * sum( sum( F[ixe,iye] ) ); s5 <- 8 * sum( sum( F[ixe,iyo] ) ) + 8 * sum( sum( F[ixo,iye] ) ); S <- hx * hy * (s1 + s2 + s3 + s4 + s5) / 9.0 return(S) } pracma/R/bsxfun.R0000644000176200001440000000176713231614333013360 0ustar liggesusers## ## b s x f u n . R ## bsxfun <- function(func, x, y) { stopifnot(is.numeric(x), is.numeric(y)) # fun <- match.fun(f) # f <- function(x, y) fun(x, y, ...) dx <- dim(x); dy <- dim(y) if ( is.vector(x) && is.vector(y) ) { z <- mapply(func, x, y) } else if (is.matrix(x) && is.matrix(y) && all(dx == dy)) { z <- sweep(x, y, MARGIN = c(1, 2), FUN = func) # dim(z) <- dx } else if (is.array(x) && is.array(y) && all(dx == dy)) { z <- mapply(func, x, y) dim(z) <- dx } else { stop("Argument 'x', 'y' must be vectors or arrays of the same size.") } return(z) } arrayfun <- function(func, ...) { # func <- match.fun(func) dots <- list(...) if (length(dots) < 1) stop("Empty list of arrays: Result cannot be computed.") d <- dim(dots[[1]]) # no test on array sizes to be fast r <- mapply(func, ...) # no try ... catch, number of variables dim(r) <- d return(r) } pracma/R/quadv.R0000644000176200001440000000467112062032441013163 0ustar liggesusersquadv <- function(f, a, b, tol = .Machine$double.eps^(1/2), ...) { stopifnot(is.numeric(a), is.numeric(b)) if (length(a) != 1 || length(b) != 1 || a > b) stop("Interval boundaries must satisfy 'a <= b'.") if (a == b) return(list(Q = 0, fcnt = 0, estim.prec = 0)) eps <- .Machine$double.eps fun <- match.fun(f) f <- function(x) fun(x, ...) # Initialize with unequal intervals h <- 0.13579 * (b-a) x <- c(a, a + h, a + 2*h, (a + b)/2, b - 2*h, b - h, b) y <- f(x[1]) for (j in 2:7) { y <- rbind(y, f(x[j])) } fcnt <- 7 # Fudge endpoints to avoid infinities if (any(!is.finite(y[1, ]))) { y[1, ] <- f(a + eps*(b-a)) fcnt <- fcnt + 1 } if (any(!is.finite(y[7, ]))) { y[7, ] <- f(b - eps*(b-a)) fcnt <- fcnt + 1 } # Call recursively the main integrator function hmin <- eps*(b-a)/1024 I1 <- .quadvstep(f,x[1], x[3], y[1, ],y[2, ], y[3, ], tol, fcnt, hmin) Q1 <- I1$Q fcnt <- I1$fcnt I2 <- .quadvstep(f,x[3], x[5], y[3, ],y[4, ], y[5, ], tol, fcnt, hmin) Q2 <- I2$Q fcnt <- I2$fcnt I3 <- .quadvstep(f,x[5], x[7], y[5, ],y[6, ], y[7, ], tol, fcnt, hmin) Q3 <- I3$Q fcnt <- I3$fcnt Q <- unname(Q1 + Q2 + Q3) return(list(Q = Q, fcnt = fcnt, estim.prec = tol*(fcnt-7)/2)) } .quadvstep <- function(f, a, b, fa, fc, fb, tol, fcnt, hmin) { maxfcnt <- 10000 # Evaluate integrand twice in interior of subinterval [a,b]. h <- b - a c <- (a + b)/2 d <- (a + c)/2 e <- (c + b)/2 fd <- f(d) fe <- f(e) fcnt <- fcnt + 2 Q1 <- (h/6) *(fa + 4*fc + fb) # Three point Simpson's rule Q2 <- (h/12)*(fa + 4*fd + 2*fc + 4*fe + fb) # Five point double Simpson's rule Q <- Q2 + (Q2 - Q1)/15 # One step of Romberg extrapolation if (!all(is.finite(Q))) stop("Improper function values: infinite or NaN encountered.") if (fcnt > maxfcnt) stop("Maximum function count exceeded; singularity likely.") if (abs(h) < hmin || c == a || c == b) stop("Minimum step size reached; singularity possible.") if (max(Q2 - Q) < tol) return(list(Q = Q, fcnt = fcnt)) Iac <- .quadvstep(f, a, c, fa, fd, fc, tol, fcnt, hmin) Qac <- Iac$Q fcnt <- Iac$fcnt Icb <- .quadvstep(f, c, b, fc, fe, fb, tol, fcnt, hmin) Qcb <- Icb$Q fcnt <- Icb$fcnt Q <- Qac + Qcb return(list(Q = Q, fcnt = fcnt)) } pracma/R/deval.R0000644000176200001440000000412114153353526013141 0ustar liggesusers## ## d e v a l . R ## deval <- function(x, y, xp, idx = NULL) { stopifnot(is.vector(x, mode = "numeric"), is.numeric(y), is.vector(xp, mode= "numeric")) if (is.vector(y)) y <- as.matrix(y) if (length(x) != nrow(y)) stop("Length of 'x' must be equal to the number of rows in 'y'.") if (is.unsorted(x)) stop("Argument vector 'x' must be sorted.") if (is.null(idx)) idx <- 1:ncol(y) if (! all(idx %in% 1:ncol(y))) stop("Indices 'idx' must be between 1 and no. of columns of 'y'.") fint <- findInterval(xp, x) flen <- length(fint) yp <- matrix(NA, nrow = flen, ncol = length(idx)) for (i in 1:flen) { fi <- fint[i] if (fi == 0) next if (fi < length(x)) { yp[i, ] <- y[fi, idx] + (xp[i] - x[fi])/(x[fi+1] - x[fi]) * (y[fi+1, idx] - y[fi, idx]) } else { if (xp[i] > x[length(x)]) { next } else { yp[i, ] <- y[fi, idx] } } } if (flen == 1) yp <- drop(yp) return(yp) } deeve <- function(x, y, yv = 0, idx = NULL){ stopifnot(is.vector(x, mode = "numeric"), is.numeric(y), is.numeric(yv), length(yv) == 1) if (is.vector(y)) y <- as.matrix(y) if (is.unsorted(x)) stop("Argument vector 'x' must be sorted.") if (length(x) != nrow(y)) stop("Length of 'x' must be equal to the number of rows in 'y'.") if (is.null(idx)) idx <- ncol(y) else if (length(idx) > 1) { idx <- idx[1] warning("Several indices found; only accepting the first one.") } y <- y[, idx] if (yv < min(y) || yv > max(y)) return(NA) # findInterval() needs nondecreasingly sorted vector fint <- findintervals(yv, y) flen <- length(fint) if (flen == 0) return(c()) x0 <- numeric(flen) for (i in 1:flen) { fi <- fint[i] if (fi < length(y)) { x0[i] <- (yv - y[fi]) / (y[fi+1] - y[fi]) * (x[fi+1] - x[fi]) + x[fi] } else { x0[i] <- x[fi] } } return(x0) } pracma/R/geo_median.R0000644000176200001440000000160012214146052014122 0ustar liggesusers## ## g e o _ m e d i a n . R Geometrical Median ## geo_median <- function(P, tol = 1e-07, maxiter = 200) { stopifnot(is.numeric(P)) if (!is.matrix(P)) stop("Argument 'P' must be a matrix (of points in R^n).") m <- nrow(P); n <- ncol(P) if (n == 1) return(list(p = median(P), d = sum(abs(P - median(P))), reltol = 0, niter = 0)) p0 <- apply(P, 2, mean) p1 <- p0 + 1 iter <- 1 while(max(abs(p0 - p1)) > tol && iter < maxiter) { iter <- iter + 1 p0 <- p1 s1 <- s2 <- 0 for (j in 1:m) { d <- Norm(P[j, ] - p0) s1 <- s1 + P[j, ]/d s2 <- s2 + 1/d } p1 <- s1 / s2 } if (iter >= maxiter) warning("Maximum number of iterations reached; may not converge.") d <- 0 for (j in 1:m) d <- d + Norm(P[j, ] - p1) return( list(p = p1, d = d, reltol = max(abs(p0 - p1)), niter = iter) ) } pracma/R/mean.R0000644000176200001440000000370212073574411012767 0ustar liggesusers## ## m e a n . R Geometric and Harmonic Mean (Matlab Style) ## harmmean <- function(x, dim = 1) { stopifnot(is.numeric(x)) if (dim < 1 || dim > ndims(x)) stop("Argument 'dim' must be between 1 and 'ndims(x)'.") if (is.vector(x)) { m <- 1 / mean( 1/x ) } else if (is.matrix(x)) { m <- 1 / apply( 1/x, c(2,1)[dim], mean) } else if (is.array(x)) { mid <- setdiff(1:ndims(x), dim) m <- 1 / apply( 1/x, mid, mean) } else { stop("Argument 'x' must be a numeric vector, matrix, or array.") } return(m) } geomean <- function(x, dim = 1) { stopifnot(is.numeric(x)) if (dim < 1 || dim > ndims(x)) stop("Argument 'dim' must be between 1 and 'ndims(x)'.") if (is.vector(x)) { m <- exp( sum( log(x) ) / length(x) ) } else if (is.matrix(x)) { n <- size(x)[dim] m <- exp( apply(log(x), c(1,2)[-dim], sum) / n ) } else if (is.array(x)) { n <- size(x)[dim] mid <- c(1:ndims(x))[-dim] m <- exp( apply(log(x), c(1:n)[-dim], sum) / n ) } else { stop("Argument 'x' must be a numeric vector, matrix, or array.") } return(m) } trimmean <- function(x, percent = 0) { stopifnot(is.numeric(x), is.numeric(percent)) if (length(percent) != 1 || percent < 0 || 100 < percent) stop("Argument 'percent' must be a scalar between 0 and 100.") # k <- percent / 100 / 2 # mean(x, trim = k, na.remove = TRUE) .tmean <- function(x, p) { n <- length(x) k <- round (n * percent/100 / 2 ) if (2*k > n-1) return(NA) x <- sort(x) mean(x[(k+1):(n-k)]) } if (is.vector(x)) { m <- .tmean(x, percent) } else if (is.matrix(x)) { m <- apply(x, 2, .tmean) } else if (is.array(x)) { stop("Function 'trimmean' not yet implemented for arrays.") } else stop("Argument 'x' must be a numeric vector or matrix.") return(m) } pracma/R/fresnel.R0000644000176200001440000000362011576123465013512 0ustar liggesusers## ## f r e s n e l . R Fresnel Integrals ## fresnelS <- Vectorize(function(x) .fresnel(x)$S) fresnelC <- Vectorize(function(x) .fresnel(x)$C) .fresnel <- function(x) { if (!is.numeric(x) || length(x) != 1) stop("Argument 'x' must be a numeric scalar.") eps <- .Machine$double.eps xa <- abs(x) px <- pi * xa t <- 0.5 * px * xa t2 <- t^2 fc <- fs <- 0 if (xa == 0) { return(list(C = fc, S = fs)) } else if (xa < 2.5) { r <- xa fc <- r for (k in 1:50) { r <- -.5 *r *(4.0*k-3.0)/k/(2.0*k-1.0)/(4.0*k+1.0)*t2 fc <- fc + r if (abs(r) < abs(fc)*eps) break } fs <- xa*t/3.0 r <- fs for (k in 1:50) { r <- -0.5*r*(4.0*k-1.0)/k/(2.0*k+1.0)/(4.0*k+3.0)*t2 fs <- fs + r if (abs(r) < abs(fs)*eps) break } } else if (xa < 4.5) { m <- trunc(42.0+1.75*t) su <- 0.0 f1 <- 0.0 f0 <- 1.0e-100 for (k in m:0) { f <- (2.0*k+3.0)*f0/t - f1 if (k == trunc(k/2)*2) { fc <- fc + f } else { fs <- fs + f } su <- su+(2.0*k+1.0)*f*f f1 <- f0 f0 <- f } q <- sqrt(su) fc <- fc*xa/q fs <- fs*xa/q } else { r=1.0 f=1.0 for (k in 1:20) { r <- -0.25*r*(4.0*k-1.0)*(4.0*k-3.0)/t2 f <- f + r } k <- 20+1 r <- 1.0/(px*xa) g <- r for (k in 1:12) { r <- -0.25*r*(4.0*k+1.0)*(4.0*k-1.0)/t2 g <- g + r } k <- 12+1 t0 <- t-trunc(t/(2.0*pi))*2.0*pi fc <- 0.5+(f*sin(t0)-g*cos(t0))/px fs <- 0.5-(f*cos(t0)+g*sin(t0))/px } if (x < 0) { fc <- -fc fs <- -fs } return(list(C = fc, S = fs)) } pracma/R/ridders.R0000644000176200001440000000266013342034603013477 0ustar liggesusers## ## r i d d e r s . R Ridders' Method ## ridders <- function(fun, a, b, maxiter = 500, tol = 1e-12, ...) { # (!is.numeric(a) && !is.complex(a) && !is(a,"mpfr") || # !is.numeric(b) && !is.complex(b) && !is(b,"mpfr")) # stop("Arguments 'a' and 'b' must be numeric, complex, or mpfr.") fun <- match.fun(fun) f <- function(x) fun(x, ...) x1 <- a; x2 <- b f1 <- f(x1); f2 <- f(x2) if (f1*f2 >= 0) stop("f(a) and f(b) must have different signs.") niter <- 2 while(abs(x1 - x2) > tol && niter < maxiter) { xm <- (x1 + x2)/2; fm <- f(xm) if (fm == 0) return(list(root = xm, f.root = 0, niter = niter, estim.prec = 0)) x3 <- xm + (xm - x1) * sign(f1 - f2) * fm / sqrt(fm^2 - f1 * f2) f3 <- f(x3); niter <- niter + 2 if (f3 == 0) return(list(root = x3, f.root = 0, niter = niter, estim.prec = 0)) if (fm * f3 < 0) { x1 <- xm; f1 <- fm x2 <- x3; f2 <- f3 } else if (f1 * f3 < 0) { x2 <- x3; f2 <- f3 } else if (f2 * f3 < 0) { x1 <- x3; f1 <- f3 } else { stop("Inform the maintainer: you should never get here.") } } if (abs(f1) < abs(f2)) { x0 <- x1; f0 <- f1 } else { x0 <- x2; f0 <- f2 } ep <- abs(x1 - x2) return(list(root = x0, f.root = f0, niter = niter, estim.prec = ep)) } pracma/R/polyval.R0000755000176200001440000000201013116316453013526 0ustar liggesusers### ### p o l y v a l . R Polynomial Evaluation ### polyval <- function(p, x) { if (length(x) == 0) return(c()) if (length(p) == 0) return(0 * x) if (!is.vector(p, mode="numeric") && !is.vector(p, mode="complex")) stop("Argument 'p' must be a real or complex vector.") if (!is.vector(x) && !is.matrix(x)) stop("Argument 'x' must be a real or complex matrix.") n <- length(p) y <- outer(x[1:length(x)], (n-1):0, "^") %*% p dim(y) <- dim(x) return(y) } polyvalm <- function(p, A) { stopifnot(is.numeric(p) || isempty(p), is.numeric(A)) if (!is.vector(p)) stop("Argument 'p' must be a numeric vector.") if (!is.matrix(A) || nrow(A) != ncol(A)) stop("Argument 'A' must be a square matrix.") n <- length(p) if (n == 0) { y <- zeros(nrow(A)) } else if (n == 1) { y <- diag(p, n) } else { id <- eye(nrow(A)) y <- p[1] * id for (i in 2:n) y <- y %*% A + p[i] * id } return(y) } pracma/R/quadinf.R0000644000176200001440000005177312416301201013473 0ustar liggesusers## ## q u a d i n f . R Infinite Integrals ## quadinf <- function(f, xa, xb, tol = 1e-12, ...) { stopifnot(is.numeric(xa), length(xa) == 1, is.numeric(xb), length(xb) == 1, is.numeric(tol), length(tol) == 1) fun <- match.fun(f) f <- function(x) fun(x, ...) if (xa == xb) { return(list(Q = 0.0, reltol = 0.0)) } else if (xa > xb) { stop("For the integration limits 'xa <= xb' is required.") } u <- -1; v <- 1 if (is.finite(xa) && is.finite(xb)) { duv <- (xb-xa)/(v-u) ff <- function(y) duv * f(xa + duv*(y-u)) } else if (is.finite(xa) && is.infinite(xb)) { ff <- function(y) { duv <- (v-u)/(1-y)^2 z <- (y-u)/(v-u) duv * f(xa + z/(1-z)) } } else if (is.infinite(xa) && is.finite(xb)) { xa <- -xb ff <- function(y) { duv = (v-u)/(1-y)^2 z <- (y-u)/(v-u) duv * f(-(xa + z/(1 - z))) } } else if (is.infinite(xa) && is.infinite(xb)) { ff <- function(y) { z <- pi * (y - u)/(v - u) - 0.5 duv <- (1/cos(z)^2)*pi / (v - u) duv * f(tan(z)) } } else { stop("Other integration domains will be treated later.") } cc <- .quadinf_pre() xx <- cc$nodes; ww <- cc$weights h <- 1.0/2.0 x <- xx[[1]]; w <- ww[[1]] s <- w[7] * ff(x[7]) for (j in 1:6) { s <- s + w[j] * (ff(x[j]) + ff(-x[j])) } Q <- s * h for (k in 2:7) { x <- xx[[k]]; w <- ww[[k]] s <- 0.0 for (j in 1:length(w)) { s <- s + w[j] * (ff(x[j]) + ff(-x[j])) } h <- h/2.0 newQ <- s*h + Q/2.0 delta <- abs(newQ - Q) Q <- newQ if (delta < tol) break } return(list(Q = Q, relerr = delta, niter = k)) } .quadinf_pre <- function() { nodes <- list( c(0.99999999999995703, 0.99999998887566488, 0.99997747719246155, 0.99751485645722437, 0.95136796407274693, 0.67427149224843574, 0), c(0.99999999995285638, 0.99999920473711468, 0.9996882640283532, 0.98704056050737687, 0.85956905868989653, 0.37720973816403414), c(0.99999999999823208, 0.99999999914270499, 0.99999989278161239, 0.99999531604122049, 0.9999093846951439, 0.99906519645578584, 0.99405550663140207, 0.97396686819567735, 0.91487926326457458, 0.78060743898320029, 0.53914670538796772, 0.19435700332493541), c(0.99999999999970801, 0.99999999999039391, 0.99999999978973275, 0.99999999678719909, 0.99999996423908089, 0.99999969889415252, 0.99999801714059533, 0.99998948201481841, 0.99995387100562794, 0.99982882207287493, 0.99945143443527451, 0.99845420876769764, 0.99610866543750853, 0.99112699244169877, 0.98145482667733508, 0.96411216422354729, 0.93516085752198463, 0.88989140278426015, 0.8233170055064023, 0.73101803479256144, 0.61027365750063889, 0.46125354393958568, 0.28787993274271589, 0.09792388528783233), c(0.99999999999988631, 0.99999999999927147, 0.99999999999582456, 0.99999999997845523, 0.99999999989927768, 0.99999999957078767, 0.99999999832336184, 0.99999999396413419, 0.99999997987450318, 0.99999993755407834, 0.9999998188937127, 0.99999950700571938, 0.99999873547186591, 0.9999969324491903, 0.99999293787666288, 0.99998451990227077, 0.99996759306794336, 0.99993501992508238, 0.99987486504878031, 0.99976797159956077, 0.9995847503515175, 0.99928111192179192, 0.9987935342988058, 0.99803333631543367, 0.99688031812819178, 0.9951760261553273, 0.99271699719682727, 0.98924843109013383, 0.98445883116743083, 0.97797623518666488, 0.96936673289691733, 0.95813602271021359, 0.94373478605275707, 0.92556863406861256, 0.90301328151357385, 0.87543539763040867, 0.84221924635075684, 0.80279874134324125, 0.75669390863372987, 0.70355000514714194, 0.64317675898520466, 0.5755844906351516, 0.50101338937930906, 0.41995211127844712, 0.33314226457763807, 0.24156631953888363, 0.14641798429058792, 0.049055967305077885), c(0.99999999999992983, 0.99999999999981715, 0.99999999999953715, 0.99999999999886124, 0.99999999999727396, 0.9999999999936463, 0.99999999998556877, 0.99999999996803313, 0.99999999993088839, 0.99999999985405608, 0.9999999996987543, 0.99999999939177686, 0.9999999987979834, 0.99999999767323666, 0.99999999558563357, 0.99999999178645604, 0.9999999850030763, 0.99999997311323585, 0.99999995264266439, 0.99999991800479471, 0.99999986037121458, 0.9999997660233324, 0.9999996139885502, 0.9999993727073353, 0.99999899541068993, 0.99999841381096466, 0.99999752962380506, 0.9999962033471661, 0.99999423962761658, 0.9999913684483448, 0.99998722128200057, 0.99998130127012064, 0.99997294642523216, 0.99996128480785662, 0.99994518061445858, 0.99992317012928922, 0.99989338654759252, 0.99985347277311132, 0.99980048143113831, 0.99973076151980844, 0.9996398313456003, 0.99952223765121717, 0.99937140114093759, 0.99917944893488586, 0.99893703483351215, 0.99863314864067743, 0.99825491617199624, 0.99778739195890642, 0.99721334704346865, 0.99651305464025375, 0.99566407681695313, 0.99464105571251116, 0.99341551316926402, 0.99195566300267757, 0.99022624046752772, 0.98818835380074255, 0.98579936302528337, 0.9830127914811011, 0.97977827580061572, 0.97604156025657673, 0.97174454156548729, 0.96682537031235583, 0.9612186151511164, 0.9548554958050226, 0.94766419061515306, 0.93957022393327472, 0.93049693799715338, 0.92036605303195274, 0.90909831816302034, 0.89661425428007602, 0.88283498824466888, 0.86768317577564591, 0.85108400798784867, 0.83296629391941079, 0.81326360850297374, 0.79191549237614201, 0.76886868676824649, 0.74407838354734734, 0.71750946748732403, 0.68913772506166759, 0.65895099174335003, 0.62695020805104285, 0.59315035359195312, 0.55758122826077816, 0.52028805069123008, 0.48133184611690499, 0.44078959903390086, 0.39875415046723772, 0.3553338251650745, 0.31065178055284592, 0.26484507658344791, 0.218063473469712, 0.1704679723820105, 0.12222912220155764, 0.073525122985671293, 0.024539763574649157), c(0.99999999999994504, 0.99999999999991063, 0.99999999999985567, 0.99999999999976874, 0.99999999999963207, 0.9999999999994188, 0.9999999999990884, 0.99999999999857991, 0.99999999999780287, 0.99999999999662348, 0.99999999999484512, 0.99999999999218125, 0.99999999998821665, 0.99999999998235345, 0.99999999997373656, 0.9999999999611503, 0.99999999994287725, 0.99999999991650601, 0.99999999987867016, 0.99999999982469845, 0.99999999974814635, 0.99999999964017294, 0.99999999948871821, 0.99999999927742189, 0.99999999898420988, 0.99999999857945798, 0.99999999802361939, 0.99999999726417366, 0.99999999623172697, 0.99999999483505064, 0.99999999295480446, 0.9999999904356327, 0.9999999870762647, 0.99999998261717338, 0.99999997672526708, 0.99999996897499022, 0.9999999588251014, 0.99999994559027294, 0.99999992840651408, 0.99999990618926848, 0.99999987758285502, 0.99999984089973593, 0.99999979404787598, 0.99999973444423285, 0.99999965891215925, 0.9999995635602319, 0.99999944363972881, 0.99999929337766846, 0.99999910578199569, 0.99999887241516183, 0.99999858313198442, 0.99999822577731134, 0.99999778583863519, 0.9999972460484261, 0.99999658593057072, 0.99999578128492839, 0.99999480360364879, 0.99999361941253884, 0.99999218953043356, 0.99999046823921378, 0.99998840235683317, 0.99998593020547477, 0.99998298046675649, 0.99997947091575146, 0.99997530702549198, 0.99997038043358921, 0.99996456726262606, 0.99995772628607793, 0.99994969693168922, 0.99994029711447929, 0.99992932089188413, 0.99991653593395113, 0.99990168080200281, 0.99988446202976611, 0.99986455100163496, 0.99984158062348205, 0.99981514178227304, 0.99978477959165113, 0.99974998942164883, 0.99971021271175098, 0.99966483256766459, 0.99961316914334686, 0.99955447481109672, 0.99948792912382323, 0.99941263357495247, 0.9993276061628299, 0.99923177576789879, 0.99912397635238981, 0.99900294099372877, 0.99886729576436373, 0.99871555347220875, 0.99854610727741266, 0.99835722420266371, 0.99814703855574838, 0.99791354528457699, 0.99765459328637784, 0.99736787869423538, 0.99705093816560908, 0.99670114219891259, 0.99631568850566088, 0.99589159546710015, 0.99542569570562278, 0.99491462980263878, 0.9943548401959208, 0.99374256529076155, 0.99307383382058434, 0.99234445949391814, 0.99155003596589164, 0.990685932173615, 0.989747288075987, 0.9887290108396023, 0.98762577151351061, 0.98643200223660843, 0.98514189402239793, 0.98374939516673121, 0.98224821032494103, 0.98063180030544861, 0.97889338262749392, 0.97702593289105788, 0.97502218700730625, 0.97287464433796378, 0.97057557179190035, 0.96811700892685626, 0.96549077410362039, 0.96268847173907823, 0.9597015007033366, 0.95652106390458091, 0.95313817910339371, 0.94954369099593627, 0.94572828460263214, 0.94168249999576925, 0.93739674839571907, 0.93286132966124002, 0.92806645119455511, 0.9230022482765543, 0.91765880584154924, 0.91202618169448679, 0.90609443116640409, 0.89985363319617007, 0.89329391781821088, 0.88640549502697863, 0.87917868497938934, 0.87160394948637765, 0.86367192473410515, 0.85537345516427143, 0.84669962843146362, 0.83764181134359994, 0.82819168667935705, 0.81834129076409778, 0.80808305167333849, 0.79740982792031223, 0.78631494747181951, 0.77479224692443527, 0.76283611066139234, 0.7504415097992404, 0.73760404072282515, 0.72431996299740742, 0.71058623643800578, 0.69640055710845916, 0.68176139201642727, 0.66666801226573758, 0.65112052442430413, 0.63511989986442174, 0.61866800183272797, 0.60176761000963341, 0.58442244232266394, 0.56663717378501877, 0.54841745213979232, 0.52976991010177454, 0.51070217400255813, 0.49122286866081144, 0.47134161831799842, 0.45106904350045196, 0.43041675369143706, 0.40939733572152948, 0.3880243378121177, 0.36631224923490407, 0.34427647557970487, 0.32193330965336914, 0.29929989806396046, 0.27639420357617861, 0.25323496335600021, 0.22984164325436074, 0.20623438831102875, 0.18243396969028913, 0.1584617282892995, 0.13433951528767221, 0.11008962993262801, 0.085734754877651045, 0.061297889413659976, 0.036802280950025079, 0.012271355118082201) ) weights = list( c(1.3581784274539089e-012, 2.1431204556943039e-007, 0.00026620051375271687, 0.018343166989927839, 0.23002239451478868, 0.96597657941230108, 1.5707963267948966), c(1.1631165814255782e-009, 1.1983701363170719e-005, 0.0029025177479013132, 0.076385743570832304, 0.53107827542805397, 1.3896147592472563), c(4.9378538776631926e-011, 1.8687282268736407e-008, 1.8263320593710658e-006, 6.2482559240744075e-005, 0.00094994680428346862, 0.0077426010260642402, 0.039175005493600777, 0.13742210773316771, 0.36046141846934365, 0.7374378483615478, 1.1934630258491568, 1.523283718634705), c(8.6759314149796041e-012, 2.5216347918530147e-010, 4.8760060974240624e-009, 6.583518512718339e-008, 6.4777566035929716e-007, 4.8237182032615495e-006, 2.8110164327940134e-005, 0.00013205234125609973, 0.00051339382406790333, 0.0016908739981426396, 0.004816298143928463, 0.012083543599157953, 0.027133510013712, 0.055289683742240581, 0.10343215422333289, 0.17932441211072828, 0.29024067931245418, 0.44083323627385823, 0.63040513516474361, 0.85017285645662, 1.0816349854900702, 1.2974757504249779, 1.4660144267169657, 1.5587733555333301), c(3.4841937670261058e-012, 2.0989335404511467e-011, 1.130605534749468e-010, 5.4828357797094976e-010, 2.409177325647594e-009, 9.649888896108962e-009, 3.543477717142195e-008, 1.199244278290277e-007, 3.7595411862360629e-007, 1.0968835125901263e-006, 2.9916615878138786e-006, 7.6595758525203149e-006, 1.8481813599879215e-005, 4.2183183841757599e-005, 9.1390817490710112e-005, 0.00018856442976700316, 0.00037166693621677759, 0.00070185951568424226, 0.0012733279447082382, 0.0022250827064786423, 0.003754250977431834, 0.0061300376320830297, 0.0097072237393916877, 0.01493783509605013, 0.022379471063648473, 0.032698732726609031, 0.046668208054846609, 0.065155533432536203, 0.089103139240941459, 0.11949741128869591, 0.15732620348436613, 0.20352399885860173, 0.25890463951405351, 0.32408253961152889, 0.39938474152571712, 0.48475809121475538, 0.57967810308778756, 0.68306851634426369, 0.79324270082051662, 0.90787937915489525, 1.0240449331118113, 1.1382722433763053, 1.2467012074518575, 1.3452788847662516, 1.4300083548722995, 1.4972262225410362, 1.543881116176959, 1.5677814313072218), c(2.1835922099233607e-012, 5.518236946817488e-012, 1.3542512912336273e-011, 3.230446433325236e-011, 7.4967397573818219e-011, 1.6939457789411645e-010, 3.7299501843052787e-010, 8.0099784479729664e-010, 1.6788897682161906e-009, 3.437185674465009e-009, 6.8784610955899e-009, 1.3464645522302038e-008, 2.5799568229535891e-008, 4.8420950198072366e-008, 8.9071395140242379e-008, 1.6069394579076223e-007, 2.8449923659159806e-007, 4.9458288702754198e-007, 8.4473756384859861e-007, 1.4183067155493917e-006, 2.3421667208528095e-006, 3.8061983264644897e-006, 6.0899100320949032e-006, 9.598194128378471e-006, 1.4908514031870607e-005, 2.2832118109036146e-005, 3.4492124759343198e-005, 5.1421497447658797e-005, 7.5683996586201475e-005, 0.00011002112846666696, 0.00015802788400701192, 0.00022435965205008549, 0.00031497209186021199, 0.00043739495615911686, 0.00060103987991147413, 0.00081754101332469483, 0.0011011261134519382, 0.0014690143599429789, 0.0019418357759843675, 0.0025440657675291729, 0.00330446699403483, 0.0042565295990178572, 0.0054388997976239977, 0.0068957859690660034, 0.0086773307495391812, 0.010839937168255907, 0.01344653660528573, 0.016566786254247574, 0.020277183817500124, 0.024661087314753281, 0.029808628117310124, 0.035816505604196434, 0.042787652157725675, 0.050830757572570467, 0.060059642358636298, 0.070592469906866989, 0.082550788110701726, 0.096058391865189455, 0.11123999898874452, 0.12821973363120098, 0.14711941325785691, 0.16805663794826914, 0.19114268413342747, 0.21648020911729615, 0.24416077786983989, 0.2742622296890681, 0.3068459094179169, 0.34195379592301678, 0.37960556938665158, 0.41979566844501548, 0.46249039805536774, 0.50762515883190806, 0.55510187800363342, 0.6047867305784036, 0.6565082461316275, 0.71005590120546891, 0.76517929890895608, 0.82158803526696467, 0.87895234555278201, 0.93690461274566783, 0.99504180404613263, 1.0529288799552665, 1.1101031939653403, 1.1660798699324344, 1.2203581095793581, 1.2724283455378627, 1.3217801174437727, 1.3679105116808963, 1.4103329714462589, 1.4485862549613224, 1.482243297885538, 1.5109197230741696, 1.5342817381543032, 1.5520531698454121, 1.5640214037732321, 1.5700420292795931), c(1.7237644036042717e-012, 2.7608587671398282e-012, 4.3888651899779303e-012, 6.9255280152681376e-012, 1.0849161834337119e-011, 1.6874519343915022e-011, 2.6061960502805292e-011, 3.9973389519930265e-011, 6.0893387064380662e-011, 9.2140564226518881e-011, 1.3850287525834143e-010, 2.0684203539029217e-010, 3.0692702078723327e-010, 4.525757610415382e-010, 6.6320863470162091e-010, 9.6594851858099294e-010, 1.3984414312565442e-009, 2.0126210218867171e-009, 2.8797013464471103e-009, 4.0967579139685196e-009, 5.7953495730966062e-009, 8.1527464828576535e-009, 1.1406465554850481e-008, 1.5872978090968231e-008, 2.1971648917089348e-008, 3.0255196464899464e-008, 4.1448233558505381e-008, 5.649576387167062e-008, 7.6623873974817583e-008, 1.0341528040745607e-007, 1.3890286996035951e-007, 1.8568491370025131e-007, 2.4706624511249697e-007, 3.2723037330517557e-007, 4.314482558716538e-007, 5.6633028402050766e-007, 7.401289349090861e-007, 9.6310052117659242e-007, 1.247935512117745e-006, 1.6102680094507651e-006, 2.0692761257364667e-006, 2.6483862254043407e-006, 3.3760952348055106e-006, 4.2869264939998223e-006, 5.4225358918240326e-006, 6.8329862774218501e-006, 8.5782093537079076e-006, 1.072967540685234e-005, 1.3372292284532372e-005, 1.6606555976508335e-005, 2.0550975944934244e-005, 2.5344798968850108e-005, 3.115105567744835e-005, 3.8159954120245754e-005, 4.6592644630494618e-005, 5.6705379853932874e-005, 6.8794093113496371e-005, 8.3199417240036467e-005, 0.00010031216460112419, 0.00012057928729056995, 0.00014451033429094585, 0.00017268441988592921, 0.00020575771467998817, 0.00024447146728689159, 0.00028966056108877171, 0.00034226260646297687, 0.00040332756454954089, 0.00047402789401816719, 0.00055566920742578549, 0.00064970141867429037, 0.00075773035782735918, 0.00088152982417296992, 0.001023054042974541, 0.0011844504858902771, 0.0013680730096097039, 0.001576495261910556, 0.0018125242991288641, 0.0020792143540086659, 0.0023798806881004382, 0.0027181134583502261, 0.0030977915233008206, 0.0035230961104429862, 0.0039985242627335309, 0.0045289019791562883, 0.0051193969614537812, 0.0057755308768065484, 0.0065031910442825787, 0.0073086414513132475, 0.0081985330052611986, 0.0091799129243109005, 0.010260233171410768, 0.011447357834799755, 0.012749569358731162, 0.01417557352833046, 0.015734503113059795, 0.01743592007397746, 0.019289816240845598, 0.02130661236612607, 0.023497155463988527, 0.025872714343617643, 0.028444973247334235, 0.03122602350533174, 0.034228353120175692, 0.037464834195628967, 0.040948708125867296, 0.04469356846276553, 0.048713341380701429, 0.053022263660287172, 0.05763485811465472, 0.062565906384455097, 0.067830419030657965, 0.073443602857638762, 0.079420825403008155, 0.085777576535268185, 0.092529427105778453, 0.099691984607788567, 0.10728084580255642, 0.11531154628093733, 0.12379950693841295, 0.13275997735244552, 0.14220797606340183, 0.15215822777419971, 0.16262509749938431, 0.17362252171163128, 0.18516393655277549, 0.19726220319743717, 0.20992953048020752, 0.22317739492218458, 0.23701645831941898, 0.25145648308451035, 0.26650624556313512, 0.28217344757959606, 0.29846462649944494, 0.31538506413267808, 0.3329386948377478, 0.35112801322442522, 0.36995398189211387, 0.38941593967921201, 0.4095115109381936, 0.43023651638978894, 0.45158488614754488, 0.47354857554061397, 0.49611748439731618, 0.51927938048424627, 0.54301982782484282, 0.5673221206467387, 0.59216722372820685, 0.6175337199299088, 0.6433977657082528, 0.66973305541029093, 0.69651079514654679, 0.72369968702683019, 0.75126592452435681, 0.77917319970479793, 0.80738272301876302, 0.83585325630826712, 0.86454115961966893, 0.89340045234719589, 0.92238288915245514, 0.9514380510163527, 0.98051345168085502, 1.0095546596294298, 1.0385054356373922, 1.0673078857975038, 1.0959026297929721, 1.1242289840506032, 1.1522251592625474, 1.1798284716173337, 1.206975566931308, 1.2336026567219467, 1.2596457651166706, 1.2850409853467271, 1.3097247444374396, 1.333634074575756, 1.3567068895156054, 1.3788822642731373, 1.4001007162694445, 1.4203044859996912, 1.4394378152464069, 1.4574472208125486, 1.4742817617280797, 1.4898932978832971, 1.5042367380636772, 1.5172702754050547, 1.5289556083545806, 1.5392581453118817, 1.5481471912355573, 1.5555961146316604, 1.5615824934918106, 1.5660882389174613, 1.5690996953516689, 1.570607716538275) ) return(list(nodes = nodes, weights = weights)) } # quadinf <- function(f, xa, xb, tol = .Machine$double.eps^0.5, # method = NULL, ...) { # stopifnot(is.numeric(xa), length(xa) == 1, # is.numeric(xb), length(xb) == 1) # # fun <- match.fun(f) # f <- function(x) fun(x, ...) # g <- function(x) (1/x^2) * f(1/x) # # if (is.null(method)) { # integ <- function(f, xa, xb) # integrate(f, xa, xb, subdivisions = 512, rel.tol = tol)$value # # } else { # methods <- c("Kronrod","Richardson","Clenshaw","Simpson","Romberg") # method <- match.arg(method, methods) # integ <- switch(method, # "Kronrod" = function(fct, xmin, xmax) quadgk(fct, xmin, xmax, tol = tol), # "Richardson" = function(fct, xmin, xmax) quadgr(fct, xmin, xmax, tol = tol)$value, # "Clenshaw" = function(fct, xmin, xmax) quadcc(fct, xmin, xmax, tol = tol), # "Romberg" = function(fct, xmin, xmax) romberg(fct, xmin, xmax, tol = tol)$value, # "Simpson" = function(fct, xmin, xmax) simpadpt(fct, xmin, xmax, tol = tol) # ) # } # # if (xa == xb) { # Q <- 0 # # } else if (xa > xb) { # Q <- -1 * quadinf(f, xb, xa, tol = tol, method = method) # # } else if (is.finite(xa) && is.finite(xb)) { # Q <- integ(f, xa, xb) # # } else if (xa == -Inf && xb == Inf) { # Q <- integ(g, -1, 0) + integ(f, -1, 1) + integ(g, 0, 1) # # } else if (is.finite(xa) && xb == Inf) { # if (xa > 0) # Q <- integ(g, 0, 1/xa) # else # Q <- integ(f, xa, 1) + integ(g, 0, 1) # # } else if (xa == -Inf && is.finite(xb)) { # if (xb < 0) # Q <- integ(g, 1/xb, 0) # else # Q <- integ(g, -1, 0) + integ(f, -1, xb) # } # # return(Q) # } pracma/R/neldermead.R0000644000176200001440000001527013377264142014157 0ustar liggesusers## ## n e l d e r m e a d . R Nelder-Mead function minimization ## nelder_mead <- function(fn, x0, ..., adapt = TRUE, tol = 1e-08, maxfeval = 5000, step = rep(1.0, length(x0))) { stopifnot(is.numeric(x0), is.numeric(step)) n <- length(x0) if (length(step) != n) stop("Argument 'step' must be of the same length as 'x0'.") fun <- match.fun(fn) fn <- function(x) fun(x, ...) # Inputs: start <- x0 # starting point reqmin <- tol # terminating limit for the variance of function values # step <- step # size and shape of the initial simplex kcount <- maxfeval # maximum number of function evaluations. konvge <- kcount/100# convergence check is carried out every # KONVGE iterations, >= 1 # Outputs: xmin <- NA # estimated minimum of the function ynewlo <- NA # minimum value of the function icount <- 0 # number of function evaluations numres <- 0 # number of restarts, must be > 1 ifault <- 0 # error indicator, 0, 1, 2 # Constants for Nelder-Mead if (adapt) { rcoeff <- 1.0 # reflection 1.0 ecoeff <- 1.0 + 2.0/n # expansion 2.0 ccoeff <- 0.75 - 1.0/(2*n) # contraction 0.5 scoeff <- 1.0 - 1.0/n # shrinking 0.5 eps <- 0.001 } else { rcoeff <- 1.0 ecoeff <- 2.0 ccoeff <- 0.5 scoeff <- 0.5 eps <- 0.001 } jcount <- konvge dn <- n nn <- n + 1 dnn <- nn del <- 1.0 rq <- reqmin * dn pbar <- numeric(n) # centroid pstar <- numeric(n) p2star <- numeric(n) y <- numeric(n+1) p <- matrix(0, n, n+1) while ( TRUE ) { # outer while loop # Initial or restarted loop p[, nn] <- start y[nn] <- fn ( start ) icount <- icount + 1 for (j in 1:n) { x <- start[j] start[j] <- start[j] + step[j] * del p[, j] <- start y[j] <- fn ( start ) icount <- icount + 1 start[j] <- x } # simplex construction is complete # Find highest and lowest y values. ilo <- which.min(y) ylo <- y[ilo] while ( icount < kcount ) { # inner while loop # indicate the vertex of the simplex to be replaced ihi <- which.max(y) ynewlo <- y[ihi] # Calculate the centroid of the simplex vertices # excepting the vertex with Y value YNEWLO pbar <- rowSums(p[, -ihi]) / dn # Reflection through the centroid pstar <- pbar + rcoeff * ( pbar - p[,ihi] ) ystar <- fn ( pstar ) icount <- icount + 1 # Successful reflection, so extension if ( ystar < ylo ) { p2star = pbar + ecoeff * ( pstar - pbar ) y2star <- fn ( p2star ) icount <- icount + 1 # Check extension. if ( ystar < y2star ) { p[, ihi] <- pstar y[ihi] <- ystar # Retain extension or contraction. } else { p[, ihi] <- p2star y[ihi] <- y2star } # No extension. } else { l <- sum(ystar < y) if ( l > 1 ) { p[, ihi] <- pstar y[ihi] <- ystar # Contraction on the Y(IHI) side of the centroid. } else if ( l == 0 ) { p2star <- pbar + ccoeff * ( p[, ihi] - pbar ) y2star <- fn ( p2star ) icount <- icount + 1 # Contract the whole simplex. if ( y[ihi] < y2star ) { for (j in 1:nn) { p[, j] <- scoeff * (p[, j] + p[, ilo]) xmin <- p[, j] y[j] <- fn ( xmin ) icount <- icount + 1 } ilo <- which.min(y) ylo <- y[ilo] next # Retain contraction } else { p[, ihi] <- p2star y[ihi] <- y2star } # Contraction on the reflection side of the centroid } else if ( l == 1 ) { p2star <- pbar + ccoeff * ( pstar - pbar ) y2star <- fn ( p2star ) icount <- icount + 1 # Retain reflection? if ( y2star <= ystar ) { p[, ihi] <- p2star y[ihi] <- y2star } else { p[, ihi] <- pstar y[ihi] <- ystar } } } # Check if YLO improved. if ( y[ihi] < ylo ) { ylo <- y[ihi] ilo <- ihi } jcount <- jcount - 1 if ( 0 < jcount ) next # Check to see if minimum reached. if ( icount <= kcount ) { jcount <- konvge x <- sum(y) / dnn z <- sum((y - x)^2) if ( z <= rq ) break } } # end inner while loop # Factorial tests to check that YNEWLO is a local minimum xmin <- p[, ilo] ynewlo <- y[ilo] if ( kcount < icount ) { ifault <- 2 break } ifault <- 0 # Check in all directions with step length for (i in 1:n) { del <- step[i] * eps xmin[i] <- xmin[i] + del z <- fn ( xmin ) icount <- icount + 1 if ( z < ynewlo ) { ifault <- 2 break } xmin[i] <- xmin[i] - del - del z <- fn ( xmin ) icount <- icount + 1 if ( z < ynewlo ) { ifault <- 2 break } xmin[i] <- xmin[i] + del } if ( ifault == 0 ) break # Restart the procedure. start <- xmin del <- eps numres <- numres + 1 } # end outer while loop return(list(xmin = xmin, fmin = ynewlo, count = icount, convergence = 0, info = list(solver = "Nelder-Mead", restarts = numres))) } # end of function pracma/R/quadgr.R0000644000176200001440000000723213101333231013316 0ustar liggesusers## ## q u a d g r . R Gauss-Richardson Quadrature ## quadgr <- function(f, a, b, tol = .Machine$double.eps^(1/2), ...) { stopifnot(is.numeric(a), length(a) == 1, is.numeric(b), length(b) == 1) fun <- match.fun(f) f <- function(x) fun(x, ...) # Check for multivalues/vectorization if (length(f(a)) != 1 || length(f(b)) != 1) stop("Function 'f' may be multi-valued; please check.") if (length(f(c(a, b))) != 2) stop("Function 'f' needs to be vectorized (see 'Vectorize').") # check order of limits if (a == b) return(list(value = 0, rel.err = 0)) else if (a > b) { tmp <- a; a <- b; b <- tmp rev_p <- TRUE } else rev_p <- FALSE # Check infinite limits if (is.infinite(a) || is.infinite(b)) { if (is.finite(a) && is.infinite(b)) { f1 <- function(t) f(a + t/(1-t)) / (1-t)^2 Q <- quadgr(f1, 0, 1, tol = tol) } else if (is.infinite(a) && is.finite(b)) { f2 <- function(t) f(b + t/(1+t)) / (1+t)^2 Q <- quadgr(f2, -1, 0, tol = tol) } else if (is.infinite(a) && is.infinite(b)) { f1 <- function(t) f(t/(1-t)) / (1-t)^2 f2 <- function(t) f(t/(1+t)) / (1+t)^2 Q1 <- quadgr(f1, 0, 1, tol = tol/2) Q2 <- quadgr(f2, -1, 0, tol = tol/2) Q <- list(value = Q1$value + Q2$value, rel.err = Q1$rel.err + Q2$rel.err) } if (rev_p) Q$value <- -Q$value return(Q) } # else ... # 12-point Gauss-Legendre quadrature xq <- c(0.12523340851146894, 0.36783149899818018, 0.58731795428661748, 0.76990267419430469, 0.9041172563704748, 0.98156063424671924) wq <- c(0.24914704581340288, 0.23349253653835478, 0.20316742672306584, 0.16007832854334636, 0.10693932599531818, 0.047175336386511842) xq <- matrix(c(xq, -xq), ncol = 1) wq <- c(wq, wq) nq <- length(xq) # Initiate vectors maxit <- 17 # max number of iterations Q0 <- zeros(maxit,1) # quadrature Q1 <- zeros(maxit,1) # first Richardson extrapolation Q2 <- zeros(maxit,1) # second Richardson extrapolation # One interval hh <- (b - a)/2 # half interval length x <- (a + b)/2 + hh*xq # nodes Q0[1] = hh * wq %*% fun(x) # quadrature for (k in 3:maxit) { hh <- hh/2 x <- cbind(x + a, x + b) / 2 # Q0[k] <- hh * wq %*% apply(f(x), 1, sum) A <- numeric(12) for (i in 1:12) A[i] <- sum(f(x[i, ])) Q0[k] <- hh * wq %*% A # Richardson extrapolation if (k >= 5) { Q1[k] <- .rich(Q0,k) Q2[k] <- .rich(Q1,k) } else if (k >= 3) { Q1[k] <- .rich(Q0,k) } # Estimate absolute error if (k >= 6) { Qv <- c(Q0[k], Q1[k], Q2[k]) Qw <- c(Q0[k-1], Q1[k-1], Q2[k-1]) } else if (k >= 4) { Qv <- c(Q0[k], Q1[k]) Qw <- c(Q0[k-1], Q1[k-1]) } else { Qv <- Q0[k] Qw <- Q0[k-1] } err <- min(abs(Qv - Qw)) j <- which.min(abs(Qv - Qw)) Q <- Qv[j] # Convergence if (err < tol || !is.finite(Q)) break } if (rev_p) Q <- -Q return(list(value = Q, rel.err = err)) } .rich <- function(Q, k) { if (Q[k] != Q[k-1]) { cc <- (Q[k-1] - Q[k-2]) / (Q[k] - Q[k-1]) - 1 } else { cc <- 1 } cc <- max(cc, 0.07) return(Q[k] + (Q[k] - Q[k-1])/cc) } pracma/R/broyden.R0000644000176200001440000000260013452637217013513 0ustar liggesusersbroyden <- function(Ffun, x0, J0 = NULL, ..., maxiter = 100, tol = .Machine$double.eps^(1/2)) { if (!is.numeric(x0)) stop("Argument 'x0' must be a numeric (row or column) vector.") fun <- match.fun(Ffun) F <- function(x) fun(x, ...) y0 <- F(x0) if (length(x0) != length(y0)) stop("Function 'F' must be 'square', i.e. from R^n to R^n .") if (length(x0) == 1) stop("Function 'F' must not be a univariate function.") # Compute once the Jacobian and its inverse if (is.null(J0)) { A0 <- jacobian(F, x0) } else { A0 <- J0 } B0 <- inv(A0) if (any(is.infinite(B0))) B0 <- diag(length(x0)) # Secant-like step in Broyden's method xnew <- x0 - B0 %*% y0 ynew <- F(xnew) k <- 1 while (k < maxiter) { s <- xnew - x0 d <- ynew - y0 if (norm(s, "F") < tol || norm(as.matrix(ynew), "F") < tol) break # Sherman-Morrison formula B0 <- B0 + (s - B0 %*% d) %*% t(s) %*% B0 / c(t(s) %*% B0 %*% d) # Update for next iteration x0 <- xnew xnew <- xnew - B0 %*% ynew y0 <- ynew ynew <- F(xnew) k <- k + 1 } if (k >= maxiter) warning(paste("Not converged: Max number of iterations reached.")) fnew <- sqrt(sum(ynew^2)) return(list(zero = c(xnew), fnorm = fnew, niter = k)) } pracma/R/softline.R0000644000176200001440000000463511617020015013665 0ustar liggesusers## ## s o f t l i n e . R Soft (Inexact) Line Search ## softline <- function(x0, d0, f, g = NULL) { if (!is.numeric(x0) || !is.numeric(d0)) stop("Arguments 'x0' and 'd0' must be numeric vectors.") if (length(x0) != length(d0)) stop("Vectors 'x0' and 'd0' must have the same length.") f <- match.fun(f) if (!is.null(g)) { g <- match.fun(g) } else { g <- function(x) grad(f, x) } # STEP 1: Initialize search parameters tau <- 0.1; chi <- 0.75 rho <- 0.1; sigma <- 0.1 mhat <- 400; epsilon <- 1e-10 xk <- c(x0) dk <- c(d0) m <- 0 # no. of function calls f0 <- f(xk) gk <- g(xk); m <- m + 2 deltaf0 <- f0 # STEP 2: Initialize line search aL <- 0; aU <- 1e9 # interval [a, b] fL <- f0 dfL <- sum(gk * dk) # derivative at x0 if (abs(dfL) > epsilon) a0 <- -2*deltaf0 / dfL else a0 <- 1 if (a0 <= 1e-9 || a0 > 1) a0 <- 1 # STEP 3 and 4: Estimate a0 and compute f0 repeat { deltak <- a0*dk f0 <- f(xk + deltak); m <- m + 1 # STEP 5: Interpolation if (f0 > (fL + rho*(a0 - aL)*dfL) && abs(fL - f0) > epsilon && m < mhat) { if (a0 < aU) aU <- a0 # Compute a0hat by extrapolation a0hat <- aL + ((a0 - aL)^2 * dfL) / (2*(fL - f0 + (a0 - aL)*dfL)) a0Lhat <- aL + tau * (aU - aL) if (a0hat < a0Lhat) a0hat <- a0Lhat a0Uhat <- aU - tau * (aU - aL) if (a0hat > a0Uhat) a0hat <- a0Uhat a0 <- a0hat # STEP 6: Compute df0 } else { df0 <- sum(g(xk + a0*dk) * dk) m <- m + 1 # STEP 7: Extrapolation if (df0 < sigma*dfL && abs(fL - f0) > epsilon && m < mhat && dfL != df0) { deltaa0 <- (a0 - aL) * df0 / (dfL - df0) if (deltaa0 <= 0) a0hat <- 2*a0 else a0hat <- a0 + deltaa0 a0Uhat <- a0 + chi * (aU - a0) if (a0hat > a0Uhat) a0hat <- a0Uhat # Pepare next iteration aL <- a0 a0 <- a0hat fL <- f0 dfL <- df0 } else { break } } } z <- max(a0, 1e-5) return(z) } pracma/R/zzz.R0000644000176200001440000000121712130550730012673 0ustar liggesusers## ## z z z . R ## # Define 'ans' as in Matlab # But: "Package namespaces are locked when loaded!" # makeActiveBinding("ans", function() .Last.value, .GlobalEnv) .pracmaEnv <- new.env() assign("elapsedTime", 0, envir = .pracmaEnv) .onLoad <- function(libname, pkgname) { # require(some_packages) # Load dynamic libraries # library.dynam(pkg, pkg, lib) environment(.pracmaEnv) <- asNamespace("pracma") # packageStartupMessage( # paste("pracma Package Version 1.4.6\n", # "Practical Numerical Math Functions\n", # "Copyright (c) 2011-2013 Hans W Borchers\n", # sep='', collapse='')) } pracma/R/lu.R0000644000176200001440000000745412425377750012507 0ustar liggesusers## ## l u. R LU Decomposition ## lu <- function(A, scheme = c("kji", "jki", "ijk")) { stopifnot(is.numeric(A), is.matrix(A)) n <- nrow(A) if (ncol(A) != n || n <= 1) stop("Argument 'A' must be a square, positive definite matrix.") scheme <- match.arg(scheme) if (scheme == "kji") { for (k in 1:(n-1)) { if (A[k, k] == 0) stop("All diagonal elements of matrix 'A' must be non-zero.") for (i in (k+1):n) { A[i, k] <- A[i, k] / A[k, k] A[i, (k+1):n] <- A[i, (k+1):n] - A[i, k] * A[k, (k+1):n] } } } else if (scheme == "jki") { if (A[1, 1] == 0) stop("All diagonal elements of matrix 'A' must be non-zero.") i <- 2:n A[i, 1] <- A[i, 1] / A[1, 1] for (j in 2:n) { if (A[j, j] == 0) stop("All diagonal elements of matrix 'A' must be non-zero.") for (k in 1:(j-1)) { i <- (k+1):n A[i, j] <- A[i, j] - A[i, k] * A[k, j] } if (j < n) { i <- (j+1):n A[i, j] <- A[i, j] / A[j, j] } } } else if (scheme == "ijk") { # 'compact' Doolittle scheme for (i in 2:n) { # j in 1:n for (j in 2:i) { if (A[j, j] == 0) stop("All diagonal elements of matrix 'A' must be non-zero.") A[i, j-1] <- A[i, j-1] / A[j-1, j-1] k <- 1:(j-1) A[i, j] <- A[i, j] - A[i, k] %*% A[k, j] } if (i < n) { k <- 1:(i-1) for (j in (i+1):n) { A[i, j] <- A[i, j] - A[i, k] %*% A[k, j] } } } } L <- eye(n) + tril(A, -1) U <- triu(A) return(list(L = L, U = U)) } lufact <- function(A) { stopifnot(is.numeric(A), is.matrix(A)) m <- nrow(A); n <- ncol(A) if (m != n || m == 1) stop("Matrix 'A' must be a square matrix with 2 rows at least.") detA <- 1 rows <- 1:n for (p in 1:(n-1)) { prow <- which.max(abs(A[p:n, p])) + (p-1) if (p < prow) { rows[c(p, prow)] <- rows[c(prow, p)] detA <- -detA } detA <- detA * A[rows[p], p] if (detA == 0) { warning("Matrix 'A' is singular, no results computed.") return(list(LU = A, perm = rows, det = NA, x = NULL)) } for (k in (p+1):n) { f <- A[rows[k], p] / A[rows[p], p] A[rows[k], p] <- f A[rows[k], (p+1):n] <- A[rows[k],(p+1):n] - f*A[rows[p], (p+1):n] } } detA <- detA * A[rows[n], n] return(list(LU = A, perm = rows, det = detA)) } lusys <- function(A, b) { stopifnot(is.numeric(A), is.matrix(A), is.numeric(b)) b <- as.matrix(b) m <- nrow(A); n <- ncol(A) if (m != n || m == 1) stop("Matrix 'A' must be a square matrix with 2 rows at least.") x <- zeros(n, 1); y <- zeros(n, 1) r <- c(1:n) for (p in 1:(n-1)) { # find the pivot row for column p q <- which.max(abs(A[p:n, p])) + (p-1) # interchange rows p and q A[c(p, q), ] <- A[c(q, p), ] r[c(p, q)] <- r[c(q, p)] if (A[p, p] == 0) stop("Matrix 'A' singular: no unique solution.") # calculate multiplier and place for (k in (p+1):n) { a = A[k, p] / A[p, p] A[k, p] <- a A[k, (p+1):n] <- A[k, (p+1):n] - a*A[p, (p+1):n] } } # solve for y y[1] = b[r[1]] for (k in 2:n) y[k] <- b[r[k]] - A[k,1:(k-1)] %*% y[1:(k-1)] # solve for x x[n] <- y[n] / A[n, n] for (k in (n-1):1) x[k] <- (y[k] - A[k, (k+1):n] %*% x[(k+1):n]) / A[k, k] return(x) } pracma/R/sigmoid.R0000644000176200001440000000101612031245633013471 0ustar liggesusers## ## s i g m o i d . R Sigmoid Function ## sigmoid <- function(x, a = 1, b = 0) { if (length(x) == 0) return(c()) stopifnot(is.numeric(x), is.numeric(a), is.numeric(b)) a <- a[1]; b <- b[1] 1 / (1 + exp(-a*(x-b))) } logit <- function(x, a = 1, b = 0) { if (length(x) == 0) return(c()) stopifnot(is.numeric(x), is.numeric(a), is.numeric(b)) a <- a[1]; b <- b[1] if (x < 0 || x > 1) return(NaN) if (x >= 0 && x <= 1) return(b + log(x/(1-x))/a) else return(NaN) } pracma/R/figure.R0000644000176200001440000000263512172306455013335 0ustar liggesusers## ## f i g u r e . r Figure (Matlab Style) ## figure <- function(figno, title = "") { if (missing(figno)) figno <- NULL else { if (!is.numeric(figno) || length(figno) != 1 || floor(figno) != ceiling(figno)) stop("The figure handle must be a whole number.") } if (!is.null(figno)) { if (figno == 1 || figno == -1) { stop("Device 1 is the null device; cannot be opened or closed.") } else if (figno == 0) { stop("Requested figure handle 0 is in use by another object.") } } # if (.Platform$OS.type == "unix") { # if (.Platform$GUI == "AQUA") win <- quartz # else if (.Platform$GUI == "X11") win <- X11 # else # stop("Unknown platform GUI for Unix platform type.") # } else if (.Platform$OS.type == "Linux") { # win <- X11 # } else if (.Platform$OS.type == "windows") { # win <- windows # } else # stop(paste("Unknown platform type:", .Platform$OS.type)) if (is.null(figno)) { dev.new() # dev.new() may be platform independent } else { devl <- dev.list() if (abs(figno) %in% devl) { if (figno > 0) dev.set(figno) else dev.off(-figno) } else { cat("Device", figno, "is not an open device. List of devices:\n") return(devl) } } invisible() } pracma/R/zeta.R0000644000176200001440000000573112073574411013016 0ustar liggesusers## ## z e t a . R eta and zeta Functions ## eta <- function(z) { if (!is.numeric(z) && !is.complex(z)) stop("Argument 'z' must be a real or complex vector.") # find special cases rez <- Re(z); imz <- Im(z) i0 <- which(z == 0) i2 <- which(z == (round(z/2)*2) & rez < 0 & imz == 0) # i1 <- which(z == (round((z-1)/2)*2+1) & rez < 0 & imz == 0) # reflection point r <- 0.5 L <- which(rez < r) if (length(L) > 0) { zL <- z[L] z[L] <- 1 - zL } # series coefficients are precalculated using the binomial distribution cc <- c( .99999999999999999997, -.99999999999999999821, .99999999999999994183, -.99999999999999875788, .99999999999998040668, -.99999999999975652196, .99999999999751767484, -.99999999997864739190, .99999999984183784058, -.99999999897537734890, .99999999412319859549, -.99999996986230482845, .99999986068828287678, -.99999941559419338151, .99999776238757525623, -.99999214148507363026, .99997457616475604912, -.99992394671207596228, .99978893483826239739, -.99945495809777621055, .99868681159465798081, -.99704078337369034566, .99374872693175507536, -.98759401271422391785, .97682326283354439220, -.95915923302922997013, .93198380256105393618, -.89273040299591077603, .83945793215750220154, -.77148960729470505477, .68992761745934847866, -.59784149990330073143, .50000000000000000000, -.40215850009669926857, .31007238254065152134, -.22851039270529494523, .16054206784249779846, -.10726959700408922397, .68016197438946063823e-1, -.40840766970770029873e-1, .23176737166455607805e-1, -.12405987285776082154e-1, .62512730682449246388e-2, -.29592166263096543401e-2, .13131884053420191908e-2, -.54504190222378945440e-3, .21106516173760261250e-3, -.76053287924037718971e-4, .25423835243950883896e-4, -.78585149263697370338e-5, .22376124247437700378e-5, -.58440580661848562719e-6, .13931171712321674741e-6, -.30137695171547022183e-7, .58768014045093054654e-8, -.10246226511017621219e-8, .15816215942184366772e-9, -.21352608103961806529e-10, .24823251635643084345e-11, -.24347803504257137241e-12, .19593322190397666205e-13, -.12421162189080181548e-14, .58167446553847312884e-16, -.17889335846010823161e-17, .27105054312137610850e-19) nz <- length(z) cc <- rev(cc) ncc <- length(cc) Z <- matrix(rep(z, each = ncc), nrow = ncc, ncol = nz) N <- matrix(rep(seq(ncc, 1, by = -1), times = nz), nrow = ncc, ncol = nz) # now compute the 'infinite' series f <- drop(cc %*% N^-Z) # and handle the special cases if (length(L) > 0) { zz <- z[L] t <- (2-2^(zz+1)) / (2.^zz-2) / pi^zz f[L] <- t * cos(pi/2*zz) * gammaz(zz) * f[L] if (length(i0) > 0) f[i0] <- 0.5 if (length(i2) > 0) f[i2] <- 0.0 } return(f) } zeta <- function(z) { zz <- 2^z k <- zz / (zz - 2) f <- k * eta(z) i1 <- which(z == 1) if (length(i1) > 0) f[i1] <- Inf return(f) } pracma/R/aitken.R0000644000176200001440000000116411556762673013340 0ustar liggesusers## ## a i t k e n . R Aitken's acceleration method ## aitken <- function(f, x0, nmax = 12, tol = 1e-8, ...) { if (!is.numeric(x0) || length(x0) != 1) stop("Argument 'x0' must be a numeric scalar.") fun <- match.fun(f) f <- function(x) fun(x, ...) x <- x0 diff <- 1 + tol niter <- 0 while (diff > tol && niter <= nmax) { gx <- f(x) ggx <- f(gx) xnew <- (x*ggx - gx^2) / (ggx - 2*gx + x) diff <- abs(x - xnew) x <- xnew niter <- niter + 1 } if (niter > nmax) warning("Maximum number of iterations exceeded.") return(x) } pracma/R/regexp.R0000644000176200001440000000566311546151101013340 0ustar liggesusers## ## r e g e x p . R ## regexp <- function(s, pat, ignorecase = FALSE, once = FALSE, split = FALSE) { # Match regular expression stopifnot(is.character(pat), is.character(s)) if (length(pat) > 1) { warning("Only the first string in argument 'pat' is taken.") pat <- pat[1] } if (length(s) > 1) { warning("Only the first string in argument 's' is taken.") s <- s[1] } if (is.na(pat) || is.na(s)) stop("In arguments 'pat' and 's' NA values not allowed.") if (once) { res <- regexpr(pat, s, ignore.case = ignorecase, perl = TRUE) } else { res <- gregexpr(pat, s, ignore.case = ignorecase, perl = TRUE)[[1]] } if (length(res) == 1 && res < 0) if (split) return(list(start = NULL, end = NULL, match = NULL, split = s)) else return(list(start = NULL, end = NULL, match = NULL, split = NULL)) # Return start, end, and match rstart <- res rend <- rstart + attr(res, "match.length") - 1 attr(rstart, "match.length") <- attr(rend, "match.length") <-NULL rmatch <- substring(s, rstart, rend) if (split) { # rsplit <- strsplit(s, pat, perl = TRUE)[[1]] # does not ignore case n <- nchar(s) rs <- c(0, rstart, n+1) re <- c(0, rend, n+1) rsplit <- c() for (i in 1:(length(rs)-1)) { if (rs[i+1] - re[i] > 1) rsplit <- c(rsplit, substr(s, re[i]+1, rs[i+1]-1)) } } else { rsplit <- NULL } list(start = rstart, end = rend, match = rmatch, split = rsplit) } regexpi <- function(s, pat, once = FALSE, split = FALSE) { regexp(s, pat, ignorecase = TRUE, once = once, split = split) } regexprep <- function(s, expr, repstr, ignorecase = FALSE, once = FALSE) { # Replace string using regular expression if (! is.character(s)) stop("Argument 's' must be a character vector.") if (!is.character(expr) || !is.character(repstr) || length(expr) != 1 || length(repstr) != 1) stop("Arguments 'old' and 'new' must be simple character strings.") if (once) { sub(expr, repstr, s, ignore.case = ignorecase, perl = TRUE) } else { gsub(expr, repstr, s, ignore.case = ignorecase, perl = TRUE) } } refindall <- function(s, pat, over = 1, ignorecase = FALSE) { if (!is.character(s) || !is.character(pat) || length(s) != 1 || length(pat) != 1) stop("Arguments 's' and 'pat' must be single strings.") if (!is.numeric(over) || length(over) != 1 || over < 1 || over != round(over)) stop("Argument 'over' must be a positive integer.") pos <- c() # positions of matches i <- 1; n <- nchar(s) found <- regexpr(pat, substr(s, i, n), ignore.case = ignorecase, perl=TRUE) while (found > 0) { pos <- c(pos, i + found - 1) i <- i + found + (over - 1) found <- regexpr(pat, substr(s, i, n), ignore.case = ignorecase, perl=TRUE) } return(pos) } pracma/R/rand.R0000644000176200001440000000415112072101505012757 0ustar liggesusers## ## r a n d . R Generate Random Matrices ## rand <- function(n = 1, m = n) { stopifnot(is.numeric(n), length(n) <= 2, is.numeric(m)) if (length(n) == 2) return(rand(n[1], n[2])) if (length(m) != 1) m <- m[1] n <- floor(n) m <- floor(m) if (n <= 0 || m <= 0) matrix(NA, 0, 0) else matrix(runif(n*m), nrow=n, ncol=m) } randn <- function(n = 1, m = n) { stopifnot(is.numeric(n), length(n) <= 2, is.numeric(m)) if (length(n) == 2) return(randn(n[1], n[2])) if (length(m) != 1) m <- m[1] n <- floor(n) m <- floor(m) if (n <= 0 || m <= 0) matrix(NA, 0, 0) else matrix(rnorm(n*m), nrow=n, ncol=m) } randi <- function(imax, n = 1, m = n) { stopifnot(is.numeric(n), length(n) == 1, is.numeric(m), length(m) == 1) if (length(imax) == 1) { imin <- 1 } else if (length(imax) == 2) { imin <- imax[1] imax <- imax[2] } else { stop("Argument 'imax' must be a scalar or have two elements.") } if (imin > imax) stop("Argument 'imax' must be greater than or equal to 'imin'.") n <- floor(n) m <- floor(m) if (n <= 0 || m <= 0) matrix(NA, 0, 0) else matrix(sample(1:imax, n*m, replace=TRUE), nrow=n, ncol=m) } rands <- function (n = 1, N = 1, r = 1) { if (n < 1 || N < 1 || r < 0) return(c()) X <- randn(n, N+1) Y <- sqrt(rowSums(X^2)) return(r * X/Y) } randp <- function(n = 1, r = 1) { if (n < 1 || r < 0) return(c()) x <- rnorm(n); y <- rnorm(n) r <- r * sqrt(runif(n)/(x^2 + y^2)) return(cbind(r*x, r*y)) } randsample <- function(n, k, w = NULL, replacement = FALSE) { stopifnot(is.numeric(n), is.numeric(k)) if (length(n) == 1) n <- 1:floor(n) else n <- c(n) if (k > length(n) && !replacement) { warning("k > n or length(n): replacement will be set to TRUE.") replacement = TRUE } if (is.numeric(w)) { if (!replacement) replacement = TRUE if (length(n) != length(w)) stop("Weights vector 'w' must have the same length as 'n'.") } sample(n, k, replace = replacement, prob = w) } pracma/R/andor.R0000644000176200001440000000044212030655336013147 0ustar liggesusers## ## a n d o r . R Logical AND, OR ## and <- function(l, k) { return((l & k) + 0) } or <- function(l, k) { return((l | k) + 0) } # and <- function(...) { # all(sapply(as.list(...), as.logical)) # } # # or <- function(...) { # any(sapply(as.list(...), as.logical)) # } pracma/R/hilb.R0000755000176200001440000000071411540452742012770 0ustar liggesusers### ### HILB.R Hilbert matrix ### hilb <- function(n) { if (!is.numeric(n)) stop("Input argument 'n' must be a numeric scalar.") if (n < 0) return(matrix(NA, nrow=0, ncol=0)) if (length(n) > 1 || ceiling(n) != floor(n)) { n <- floor(n[1]) warning("Size 'n' should be a single integer number.") } J <- matrix(rep(1:n, each=n), n, n) I <- t(J) E <- matrix(1, n, n) H <- E / (I + J - 1) return(H) } pracma/R/roots.R0000755000176200001440000000622313471575664013237 0ustar liggesusers### ### ROOTS.R Matlab ROOTS Function ### roots <- function(p) { if (is.null(p) || length(p) == 0) return(matrix(0, nrow=0, ncol=0)) if ( !is.vector(p, mode="numeric") && !is.vector(p, mode="complex") ) stop("Argument p must be a vector of real or complex numbers.") if (length(p) == 1) return(matrix(0, nrow=0, ncol=0)) # Find non-zero entries in p inz <- which(p != 0) nnz <- length(inz) if (nnz == 0) return(c()) # Strip leading and trailing zeros, but remember the trailing zeros q <- p[inz[1]:inz[nnz]] r <- rep(0, length(p) - inz[nnz]) A <- compan(q) return(c(r, eig(A))) } # Greatest common factor/divisor of polynomials polygcf <- function(p, q, tol=1e-12) { if ( !is.vector(p, mode="numeric") && !is.vector(p, mode="complex") ) stop("Arguments 'p' must be a real or complex vector.") if ( !is.vector(q, mode="numeric") && !is.vector(q, mode="complex") ) stop("Arguments 'q' must be a real or complex vector.") np <- Norm(p) pd <- polydiv(p,q) a <- pd$d; r0 <- pd$r if (Norm(r0) > np*tol) { pd <- polydiv(q,r0) a <- pd$d; r1 <- pd$r if (Norm(r1) > np*tol) { rn <- 1 while (Norm(rn) > np*tol) { pd <- polydiv(r0,r1) a <- pd$d; rn <- pd$r r0 <- r1 r1 <- rn } g <- r0 } else { g <- r0 } } else { g <- q } # g <- g / g[1] return(g) } # Determine multiplicity of polynomial roots rootsmult <- function(p, r, tol=1e-12) { np <- Norm(p) v <- abs(polyval(p, r)) if (v > np*tol) { warning("Value 'r' is not root of polynomial 'p'.") return(0) } else { n <- 0 while (v < np*tol) { p <- polyder(p) v <- abs(polyval(p,r)) n <- n+1 } return(n) } } # Find the multiplicity of all roots of a polynomial polyroots <- function(p, ntol = 1e-04, ztol = 1e-08) { stopifnot(is.numeric(p)) # Multiplicity of 0 as root wp <- which(p != 0) minp <- min(wp); maxp <- max(wp) mz <- length(p) - maxp p0 <- p[minp:maxp] zp <- zm <- c() if (mz > 0) {zp <- c(zp, 0); zm <- c(zm, mz)} if (length(p0) < 2) return(data.frame(root = zp, mult = zm)) s <- abs(p0[length(p0)] / p0[1]) if (s < 1) p0 <- p0[length(p0):1] q0 <- polyder(p0) g1 <- p0 / p0[1] g2 <- q0[1:max(which(q0 != 0))] / q0[1] for (k in 3:(2*length(p0))) { l12 <- length(g1) - length(g2); l21 <- -l12 g3 <- c(g2, zeros(1, l12)) - c(g1, zeros(1, l21)) wh <- which(abs(g3) > ztol) g3 <- if (isempty(wh)) c(0) else g3[min(wh):max(wh)] ren <- Norm(g3, Inf) / Norm(g2, Inf) if (ren < ntol) break if(l12 >= 0) g1 <- g2 g2 <- g3 / g3[1] } g0 <- g1 u0 <- deconv(p0, g0)$q v0 <- deconv(q0, g0)$q w0 <- polyder(u0) z0 <- roots(u0) m0 <- polyval(v0, z0) / polyval(w0, z0) if (s < 1) z0 <- z0^-1 zp <- c(zp, z0); zm <- c(zm, round(abs(m0))) return(data.frame(root = zp, mult = zm)) } pracma/R/circshift.R0000644000176200001440000000074711676435402014037 0ustar liggesuserscircshift <- function(a, sz) { if (is.null(a)) return(a) if (is.vector(a) && length(sz) == 1) { n <- length(a) s <- sz %% n a <- a[(1:n-s-1) %% n + 1] } else if (is.matrix(a) && length(sz) == 2) { n <- nrow(a); m <- ncol(a) s1 <- sz[1] %% n s2 <- sz[2] %% m a <- a[(1:n-s1-1) %% n + 1, (1:m-s2-1) %% m + 1] } else stop("Length of 'sz' must be equal to the no. of dimensions of 'a'.") return(a) } pracma/R/lsqnonlin.R0000644000176200001440000000712212301624171014055 0ustar liggesusers## ## l s q n o n l i n . R Nonlinear Least-Squares Fitting ## lsqnonlin <- function(fun, x0, options = list(), ...) { stopifnot(is.numeric(x0)) #-- Option list handling ----------- opts <- list(tau = 1e-3, tolx = 1e-8, tolg = 1e-8, maxeval = 700) namedOpts <- match.arg(names(options), choices = names(opts), several.ok = TRUE) if (!is.null(names(options))) opts[namedOpts] <- options # x0 is good...not so good start value tau <- opts$tau # tau = 1e-6...1e-3...1 tolx <- opts$tolx # tolg <- opts$tolg # maxeval <- opts$maxeval # max. number of iterations #-- Matching function fct <- match.fun(fun) fun <- function(x) fct(x, ...) n <- length(x0) # fun: R^n --> R^m; n <- nrow(A) m <- length(fun(x0)) # Initialization: Compute f, r, and J x <- x0; r <- fun(x) f <- 0.5 * sum(r^2); J <- jacobian(fun, x) g <- t(J) %*% r; ng <- Norm(g, Inf) A <- t(J) %*% J # g is a column vector mu <- tau * max(diag(A)) # damping parameter nu <- 2; nh <- 0 #-- Main loop errno <- 0 k <- 1 while (k < maxeval) { k <- k + 1 # h <- solve(A + mu*eye(n), -g) # compute step through linear system R <- chol(A + mu*eye(n)) # use the Cholesky decomposition h <- c(-t(g) %*% chol2inv(R)) # h <- solve(R, solve(t(R), -g)) nh <- Norm(h); nx <- tolx + Norm(x) if (nh <= tolx * nx) {errno <- 1; break} xnew <- x + h; h <- xnew - x dL <- sum(h * (mu*h - g))/2 rn <- fun(xnew) fn <- 0.5 * sum(rn^2); Jn <- jacobian(fun, xnew) if (length(rn) != length(r)) {df <- f - fn } else {df <- sum((r - rn) * (r + rn))/2} if (dL > 0 && df > 0) { x <- xnew; f <- fn; J <- Jn; r <- rn; A <- t(J) %*% J; g <- t(J) %*% r; ng <- Norm(g,Inf) mu <- mu * max(1/3, 1 - (2*df/dL - 1)^3); nu <- 2 } else { mu <- mu*nu; nu <- 2*nu } if (ng <= tolg) { errno <- 2; break } } if (k >= maxeval) errno <- 3 errmess <- switch(errno, "Stopped by small x-step.", "Stopped by small gradient.", "No. of function evaluations exceeded.") return(list(x = c(xnew), ssq = sum(fun(xnew)^2), ng = ng, nh = nh, mu = mu, neval = k, errno = errno, errmess = errmess)) } # lsqnonneg <- function(C, d) { # stopifnot(is.numeric(C), is.numeric(d)) # if (!is.matrix(C) || !is.vector(d)) # stop("Argument 'C' must be a matrix, 'd' a vector.") # n <- nrow(C); m <- ncol(C); ld <- length(d) # if (n != ld) # stop("Arguments 'C' and 'd' have nonconformable dimensions.") # # fn <- function(x) C %*% as.matrix(exp(x)) - d # x0 <- rep(0, m) # sol <- lsqnonlin(fn, x0) # # xs <- exp(sol$x) # resi <- d - C %*% as.matrix(xs) # resn <- Norm(resi) # return(list(x = xs, resnorm = resn, residual = resi, # exitflag = sol$errmess)) # } lsqcurvefit <- function(fun, p0, xdata, ydata) { stopifnot(is.function(fun), is.numeric(p0)) stopifnot(is.numeric(xdata), is.numeric(ydata)) if (length(xdata) != length(ydata)) stop("Aguments 'xdata', 'ydata' must have the same length.") fn <- function(p, x) fun(p, xdata) - ydata lsqnonlin(fn, p0) } pracma/R/linprog.R0000644000176200001440000001620312114645076013523 0ustar liggesusers## ## l i n p r o g . R Linear Programming Solver ## linprog <- function(cc, A = NULL, b = NULL, Aeq = NULL, beq = NULL, lb = NULL, ub = NULL, x0 = NULL, I0 = NULL, bigM = 100, maxiter = 20, maximize = FALSE) { .lp.check(cc, A, b, Aeq, beq, lb, ub, x0, I0) if (maximize) cc <- -cc # there are only inequality constraints if (is.null(Aeq) && all(b >= 0)) { # go and find a base vector and index set Pin <- .lp.create(cc, A, b, lb, ub) Sin <- .lp.solve(Pin$cc, Pin$A, Pin$b, Pin$x0, Pin$I0, maxiter = maxiter) # find a feasible base vector first } else { # there are only equality constraints if (is.null(A) && is.null(lb) && is.null(ub)) { A <- Aeq b <- beq cc0 <- cc # there are both equality and inequality constraints } else { Pin <- .lp.create(cc, A, b, lb, ub) Ain <- Pin$A bin <- Pin$b cc0 <- Pin$cc if (!is.null(Aeq)) { Aeq <- cbind(Aeq, matrix(0, nrow = nrow(Aeq), ncol = ncol(Ain)-ncol(Aeq))) A <- rbind(Ain, Aeq) b <- c(Pin$b, beq) } else { A <- Ain b <- bin } } # only equalities; now guarantee that b >= 0 inds <- which(b < 0) if (length(inds) > 0) { A[inds, ] <- -A[inds, ] b[inds] <- -b[inds] } # all constraints combined in one equality matrix A and vectors b, cc m <- nrow(A); n <- ncol(A) A0 <- cbind(A, diag(m)) b0 <- b x0 <- c(rep(0, n), b0) I0 <- (n+1):(n+m) if (bigM > 0) { # big-M approach M <- bigM k <- 1; kmax <- 8 while (k < kmax) { f <- c(cc0, rep(M, m)) Sin <- .lp.solve(f, A0, b0, x0, I0, maxiter = maxiter) if (Sin$errno < 0 || all(Sin$x[I0] == 0)) break M <- 10 * M k <- k + 1 } # browser() if (k >= kmax) { Sin$errno <- -4 } } else { # phase-I approach f <- rep(1, n+m) Sin <- .lp.solve(f, A0, b0, x0, I0, maxiter = maxiter) if (Sin$errno < 0) { Sin$errno <- -5 } else { x1 <- Sin$x[1:n]; z1 <- Sin$x[(n+1):(n+m)] I1 <- which(x1 != 0) if (length(I1) != m) { Sin$errno <- -5 } else if (all(z1 == 0)) { Sin <- .lp.solve(cc0, A, b, x1, I1, maxiter = maxiter) } else Sin$errno <- -2 } } } errno <- Sin$errno errmsg <- c("Maximum no. of iterations exceeded.", "Problem is most likely unfeasible.", "Problem is most likely unbounded.", "Big-M appraoch not successful.", "Phase-I approach not successful.") if (errno < 0) { mess <- errmsg[abs(errno)] return(list(x = NA, fval = NA, errno = errno, message = mess)) } else { mess <- "Solver LP converged successfully." x <- Sin$x[1:length(cc)] y <- Sin$y[1:length(b)] f <- sum(cc * x) if (maximize) f <- -f return(list(x = x, fval = f, errno = errno, message = mess)) } cat("LP solver stopped.\n") } .lp.check <- function(cc, A, b, Aeq, beq, lb, ub, x0, I0) { stopifnot(is.numeric(cc)) if (is.numeric(lb) && length(lb) != length(cc) || is.numeric(ub) && length(ub) != length(cc)) stop("Arguments 'cc', 'lb', and 'ub' must have equal lengths.") if (!is.null(A)) { if (is.null(b)) stop("Vector 'b' must be present if 'A' is.") if (!is.matrix(A)) stop("Argument 'A' must be a matrix.") m <- nrow(A); n <- ncol(A) if (length(cc) != n) stop("Length of 'cc' does not fit to 'ncol(A)'.") if (length(b) != m) stop("Length of 'b' does not fit to 'nrow(A)'.") } } .lp.create <- function(cc, Ain, bin, lb, ub) { A <- Ain b <- bin if (is.null(Ain)) { m_in <- 0 n <- length(cc) } else { m_in <- nrow(Ain) n <- ncol(Ain) } # upper bounds if (!is.null(ub)) { inds <- which(is.finite(ub)) m1 <- length(inds) B <- matrix(0, nrow = m1, ncol = n) for (k in 1:m1) B[k, inds[k]] <- 1 A <- rbind(A, B) b <- c(b, ub[inds]) } # lower bounds if (!is.null(lb)) { inds <- which(lb > 0) # all(lb >= 0) m2 <- length(inds) B <- matrix(0, nrow = m2, ncol = n) for (k in 1:m2) B[k, inds[k]] <- -1 A <- rbind(A, B) b <- c(b, -lb[inds]) } # slack variables and base vector m <- nrow(A) # m <- m_in + m1 + m2 A <- cbind(A, diag(m)) cc <- c(cc, rep(0, m)) v <- c(rep(0, n), b) I <- (n+1):(n+m) return(list(A = A, b = b, cc = cc, x0 = v, I0 = I)) } .lp.solve <- function(cc, A, b, x, I, maxiter = maxiter) { # Linear program A x = b, minimize cc * x. # x is assumed to be a base vector with index set I. stopifnot(is.numeric(A), is.numeric(b), is.numeric(x)) if (!is.matrix(A)) stop("Argument 'A' must be a numeric matrix.") m <- nrow(A); n <- ncol(A) if (length(b) != m || length(x) != n) stop("One of arguments 'x' or 'b' does not have correct length.") # cat("Start value:", cc %*% x, "\n") # check I: must be a strict subset of {1, ..., n} iter <- 0 errno <- 0 while (iter < maxiter) { iter <- iter + 1 J <- setdiff(1:n, I) B <- A[, I]; N <- A[, J] x_I <- x[I]; x_J <- x[J] c_I <- cc[I]; c_J <- cc[J] # Transform base vector y <- solve(t(B), c_I) u <- numeric(n) for (j in J) u[j] <- cc[j] - t(A[, j]) %*% y # Case 1: x is a solution of the LP if (all(u >= 0)) { # cat("Solution found!\n") errno <- 1 break } # Case 2: r in J with u[j] < 0 r <- which(u < 0) if (length(r) > 1) r <- r[sample(1:length(r), 1)] dd <- solve(B, A[, r]) d <- numeric(n) d[I] <- dd # Case 2a: The LP does not have a solution if (all(d <= 0)) { # cat("LP is infeasible!\n") errno <- -2 break } # Case 2b: i in I with d[i] > 0 i0 <- which(d > 0) t <- min(x[i0]/d[i0]) s <- which(x[i0]/d[i0] == t); s <- i0[s] if (length(s) > 1) s <- s[sample(1:length(s), 1)] z <- numeric(n) z[r] <- t z[I] <- x_I - t*d[I] # Define a new base vector x <- z is <- which(I == s) I[is] <- r # cat("New base vector:", cc %*% x, "\n") } if (iter >= maxiter) { errno <- -1 } if (errno < 0) { x <- y <- NA } return(list(x = x, dual.x = y, errno = errno)) } pracma/R/ode23.R0000644000176200001440000000444412660202404012757 0ustar liggesusers## ## o d e 2 3 . R ODE Solver ## ode23 <- function(f, t0, tfinal, y0, ..., rtol = 1e-3, atol = 1e-6) { stopifnot(is.numeric(y0), is.numeric(t0), length(t0) == 1, is.numeric(tfinal), length(tfinal) == 1) if (is.vector(y0)) { y0 <- as.matrix(y0) } else if (is.matrix(y0)) { if (ncol(y0) != 1) stop("Argument 'y0' must be a vector or single column matrix.") } fun <- match.fun(f) f <- function(t, y) fun(t, y, ...) if (length(f(t0, y0)) != length(y0)) stop("Argument 'f' does not describe a system of equations.") # Set initial parameters eps <- .Machine$double.eps # Matlab parameters realmin <- 1e-100 tdir <- sign(tfinal - t0) threshold <- atol / rtol hmax <- abs(0.1 * (tfinal-t0)) t <- t0; tout <- t y <- y0; yout <- t(y) # Compute initial step size s1 <- f(t, y) r <- max(abs(s1 / max(abs(y), threshold))) + realmin h <- tdir * 0.8 * rtol^(1/3) / r # Main loop while (t != tfinal) { hmin <- 16 * eps * abs(t) if (abs(h) > hmax) { h <- tdir * hmax } else if (abs(h) < hmin) { h <- tdir * hmin } # Stretch the step if t is close to tfinal if (1.1 * abs(h) >= abs(tfinal - t)) h <- tfinal - t # Attempt a step s2 <- f(t + h/2, y + h/2 * s1) s3 <- f(t + 3*h/4, y + 3*h/4 * s2) tnew <- t + h ynew <- y + h * (2*s1 + 3*s2 + 4*s3) / 9 s4 <- f(tnew, ynew) # Estimate the error e <- h * (-5*s1 + 6*s2 + 8*s3 - 9*s4) / 72 err <- max(abs(e / max(max(abs(y), abs(ynew)), threshold))) + realmin # Accept the solution if the estimated error is less than the tolerance if (err <= rtol) { t <- tnew y <- ynew tout <- c(tout, t) yout <- rbind(yout, t(y)) s1 <- s4 # Reuse final function value to start new step. } # Compute a new step size h <- h * min(5, 0.8 * (rtol/err)^(1/3)) # Exit early if step size is too small if (abs(h) <= hmin) { warning("Step size too small.") t <- tfinal } } # end while # Return results return(list(t = c(tout), y = yout)) } pracma/R/gaussLegendre.R0000644000176200001440000000254512001517521014631 0ustar liggesusers## ## g a u s s L e g e n d r e . R Gauss-Legendre et al. Quadrature Formula ## gaussLegendre <- function(n, a, b) { stopifnot(is.numeric(a), length(a) == 1, is.numeric(b), length(b) == 1, is.numeric(n), length(n) == 1, n >= 2) i <- seq(1, n-1, by = 1) d <- i / sqrt(4*i^2 - 1) E <- eigen(Diag(d, 1) + Diag(d, -1), symmetric = TRUE) L <- E$values V <- E$vectors inds <- order(L) x <- L[inds] V <- t(V[, inds]) w <- 2 * V[, 1]^2 x <- 0.5 * ((b-a)*x + a+b) w <- -0.5 * (a-b)*w return(list(x = x, w = w)) } gaussHermite <- function(n) { stopifnot(is.numeric(n), length(n) == 1, n >= 2) i <- seq(1, n-1, by = 1) d <- sqrt(i/2) E <- eigen(Diag(d, 1) + Diag(d, -1), symmetric = TRUE) L <- E$values V <- E$vectors inds <- order(L) x <- L[inds] V <- t(V[, inds]) w <- sqrt(pi) * V[, 1]^2 return(list(x = x, w = w)) } gaussLaguerre <- function(n, a = 0) { stopifnot(is.numeric(n), length(n) == 1, n >= 2) stopifnot(is.numeric(a), length(a) == 1, a >= 0) i <- 1:n d <- (2*i - 1) + a b <- sqrt( i[1:(n-1)] * ((1:(n-1)) + a) ) E <- eigen(Diag(d) + Diag(b, 1) + Diag(b, -1)) L <- E$values V <- E$vectors inds <- order(L) x <- L[inds] V <- t(V[, inds]) w <- gamma(a + 1) * V[, 1]^2 return(list(x = x, w = w)) } pracma/R/linspace.R0000644000176200001440000000062211540452742013643 0ustar liggesusers## ## l i n s p a c e . R ## linspace <- function(x1, x2, n=100) { stopifnot(is.numeric(x1), is.numeric(x2), length(x1)==1, length(x2)==1) n <- floor(n) if (n <= 1) x2 else seq(x1, x2, length.out=n) } logspace <- function(x1, x2, n=50) { if (x2 == pi) x2 <- log10(x2) 10^linspace(x1, x2, n) } logseq <- function(x1, x2, n=100) { x <- linspace(log(abs(x1)), log(abs(x2)), n) exp(x) } pracma/R/pchip.R0000644000176200001440000000424612403264462013155 0ustar liggesusers## ## p c h i p . R Piecwise Cubic Hermitean Interpolation Polynomials ## pchip <- function(xi, yi, x) { stopifnot(is.numeric(xi), is.numeric(yi), is.numeric(x)) # xi <- c(xi); yi <- c(yi); x <- c(x) if (!is.sorted(xi)) stop("Argument 'xi' must be a sorted vector of real numbers.") n <- length(xi); if (length(yi) != n) stop("Arguments 'xi', 'yi' must be vectors of equal length.") if (n <= 2) stop("At least three points needed for cubic interpolation.") # First derivatives h <- diff(xi) delta <- diff(yi) / h d <- .pchipslopes(h, delta) # Piecewise polynomial coefficients a <- (3*delta - 2*d[1:(n-1)] - d[2:n]) / h b <- (d[1:(n-1)] - 2*delta + d[2:n]) / h^2; # Find subinterval indices k so that xi[k] <= x < xi[k+1] k <- rep(1, length(x)) for (j in 2:(n-1)) { k[xi[j] <= x] <- j } # Evaluate interpolant s <- x - xi[k] v <- yi[k] + s*(d[k] + s*(a[k] + s*b[k])) return(v) } .pchipslopes <- function(h, delta) { # Slopes at interior points n <- length(h) + 1 d <- numeric(length(h)) k <- which(sign(delta[1:(n-2)]) * sign(delta[2:(n-1)]) > 0) + 1 w1 <- 2*h[k] + h[k-1] w2 <- h[k]+2*h[k-1] d[k] <- (w1+w2) / (w1/delta[k-1] + w2/delta[k]) # Slopes at endpoints d[1] <- .pchipend(h[1], h[2], delta[1], delta[2]) d[n] <- .pchipend(h[n-1], h[n-2], delta[n-1], delta[n-2]) return(d) } .pchipend <- function(h1, h2, del1, del2) { # Noncentered, shape-preserving, three-point formula. d <- ((2*h1 + h2)*del1 - h1*del2) / (h1 + h2) if (sign(d) != sign(del1)) { d <- 0 } else if ((sign(del1) != sign(del2)) && (abs(d) > abs(3*del1))) { d <- 3*del1 } return(d) } pchipfun <- function(xi, yi) { stopifnot(is.numeric(xi), is.numeric(yi)) # xi <- c(xi); yi <- c(yi) if (!is.sorted(xi)) stop("Argument 'xi' must be a sorted vector of real numbers.") n <- length(xi); if (length(yi) != n) stop("Arguments 'xi', 'yi' must be vectors of equal length.") if (n <= 2) stop("At least three points needed for cubic interpolation.") function(x) pchip(xi, yi, x) } pracma/R/beep.R0000644000176200001440000000361312072652461012764 0ustar liggesusers## ## b e e p . R ## beep <- function() cat("\a") disp <- function(...) cat(..., "\n") ver <- function() { z <- list() z$R.version <- R.Version() z$platform <- z$R.version$platform if (nzchar(.Platform$r_arch)) z$platform <- paste(z$platform, .Platform$r_arch, sep = "/") z$platform <- paste(z$platform, " (", 8 * .Machine$sizeof.pointer, "-bit)", sep = "") z$locale <- Sys.getlocale() cat("------------------------------------------------------------------------\n") cat("Version: ", z$R.version$version.string, "\n", sep = "") cat("License: Gnu General Public License, GPL-3\n", sep = "") cat("Platform: ", z$R.version$platform, "\n", sep = "") cat("Op.System: ", z$platform, "\n", sep = "") cat("Locale: ", z$locale, "\n", sep = "") cat("------------------------------------------------------------------------\n") # Loaded base and contributed packages session_info <- sessionInfo() base_pkgs <- session_info$basePkgs cat("Loaded Base Packages:\n ", base_pkgs, "\n", sep = " ") cat("Contributed Packages:\n") other_pkgs <- session_info$otherPkgs for (pack in other_pkgs) { pkg_name <- pack$Package; l <- max(12 - nchar(pkg_name), 2) pkg_name <- paste(pkg_name, blanks(l), sep = "", collapse = "") pkg_version <- pack$Version; l <- max(8 - nchar(pkg_version), 2) pkg_version <- paste("Version ", pkg_version, blanks(l), sep = "", collapse = "") pkg_date <- substr(pack$Date, 1, 10) pkg_date <- paste("(", pkg_date, ")", sep = "", collapse = "") pkg_license <- pack$License pkg_license <- paste(" License ", pkg_license, sep = "", collapse = "") cat(pkg_name, pkg_version, pkg_date, pkg_license, "\n", sep = " ") } cat("------------------------------------------------------------------------\n") invisible(NULL) } pracma/R/midpoint.R0000644000176200001440000000330212431645662013673 0ustar liggesusers.midp <- function(f, x0, xfinal, y0, nsteps) { # stopifnot(nsteps >= 2, x0 < xfinal, f(...) column vector) h <- (xfinal - x0) / nsteps x <- x0 y1 <- y0 y2 <- y1 + h * f(x, y1) for (i in 1:(nsteps-1)) { x <- x + h yy <- y1 + 2.0 * h * f(x, y2) y1 <- y2 y2 <- yy } 0.5*(y1 + y2 + h * f(x, yy)) } midpoint <- function(f, t0, tfinal, y0, tol = 1e-07, kmax = 25) { stopifnot(is.numeric(y0), is.numeric(t0), length(t0) == 1, is.numeric(tfinal), length(tfinal) == 1) n <- length(y0) # Richardson extrapolation nsteps <- 2 r <- matrix(NA, kmax, n) r[1, ] <- .midp(f, t0, tfinal, y0, nsteps) rold <- r[1, ] for (k in 2:kmax) { nsteps <- 2*nsteps r[k, 1:n] <- .midp(f, t0, tfinal, y0, nsteps) for (j in (k-1):1) { cc <- 4^(k-j) r[j, ] <- (cc * r[j+1, ] - r[j, ]) / (cc - 1.0) } dr <- r[1, ] - rold err <- sqrt(dot(dr, dr)/n) if (err < tol) break rold <- r[1, ] } return(r[1, ]) } bulirsch_stoer <- function(f, t, y0, ..., tol = 1e-07) { stopifnot(is.numeric(t), is.numeric(y0)) fun <- match.fun(f) f <- function(t, y) fun(t, y, ...) # as row vector x <- t D <- length(f(x[1], y0)) # image of f if (length(y0) != D) stop("Argument 'y0' and 'f(..)' must be of the same length.") N <- length(x) # no. of grid points if (N < 2) stop("Argument 't' must be a vector of length at least 2.") mtol <- tol / (N-1) z <- matrix(0, N, D) z[1, ] <- y0 for (i in 2:N) { z[i, ] <- midpoint(f, x[i-1], x[i], z[i-1, ], tol = mtol) } return(z) } pracma/R/quadcc.R0000644000176200001440000000156512416301201013276 0ustar liggesusers## ## q u a d c c . R Adaptive Clenshaw-Curtis Quadrature ## quadcc <- function(f, a, b, tol = .Machine$double.eps^0.5, ...) { stopifnot(is.numeric(a), length(a) == 1, is.numeric(b), length(b) == 1) eps <- .Machine$double.eps fun <- match.fun(f) f <- function(x) fun(x, ...) if (a == b) return(0) else if (a > b) return(-1 * quadgk(f, b, a, tol = tol)) if (!is.finite(f(a))) a <- a + eps * sign(b-a) if (!is.finite(f(b))) b <- b - eps * sign(b-a) .ccadpt <- function(f, a, b, tol = tol) { Q4 <- clenshaw_curtis(f, a, b, n = 4) Q8 <- clenshaw_curtis(f, a, b, n = 8) if (abs(Q4 - Q8) < tol) { return(Q8) } # else Q2 <- .ccadpt(f, (a+b)/2, b, tol = tol) Q1 <- .ccadpt(f, a, (a+b)/2, tol = tol) return(Q1 + Q2) } return(.ccadpt(f, a, b, tol)) } pracma/R/newmark.R0000644000176200001440000000223211654745276013525 0ustar liggesusers## ## n e w m a r k . R Newmark Method ## newmark <- function(f, t0, t1, y0, ..., N = 100, zeta = 0.25, theta = 0.5) { stopifnot(is.numeric(y0), is.numeric(t0), length(t0) == 1, is.numeric(N), is.numeric(t1), length(t1) == 1) if (length(y0) != 2) stop("Argument 'y0' must be a numeric vector of length 2.") N <- floor(N) if (N < 2) stop("Argument 'N' must be an integer greater than 1.") fun <- match.fun(f) f <- function(t, y) fun(t, y, ...) #if (length(f(t0, y0)) != 2) # stop("Function 'f' must always return a vector of length 2.") yout <- matrix(NA, N, 2) yout[1, ] <- y <- c(y0) h <- (t1 - t0)/(N-1) t <- 0 ts <- linspace(t0, t1, N) f1 <- f(ts[1], y) # internal function used for root finding nmfun <- function(w) { f2 <- f(t, w) z1 <- w[1] - y[1] - h * y[2] - h^2 * (zeta*f2 + (0.5 - zeta) * f1) z2 <- w[2] - y[2] - h * ((1-theta)*f1 + theta*f2) c(z1, z2) } for (i in 2:N) { t <- ts[i] w <- fsolve(nmfun, y)$x f1 <- f(t, w) yout[i, ] <- w y <- w } return(list(t = ts, y = yout)) } pracma/R/flipdim.R0000644000176200001440000000127211540452742013473 0ustar liggesusers## ## Matlab flipping matrices functions ## flipdim <- function(a, dim=1) { if (!is.matrix(a)) stop("Argument 'a' must ba a matrix.") if (!(dim %in% c(1,2))) stop("Argument 'dim' must be 1 or 2 (for rows or columns).") if (dim == 1) { a <- a[nrow(a):1, ] } else { a <- a[ ,ncol(a):1] } return(a) } flipud <- function(a) { flipdim(a, 1) } fliplr <- function(a) { flipdim(a, 2) } rot90 <- function(a, k=1) { if (!is.matrix(a)) stop("Argument 'a' must ba a matrix.") if (floor(k) != ceiling(k)) k <- 0 switch(EXPR = 1 + (k %% 4), a, t(a[, seq(ncol(a), 1, by=-1)]), a[seq(nrow(a), 1, by=-1), seq(ncol(a), 1, by=-1)], {a <- t(a); a[, seq(ncol(a), 1, by=-1)]} ) } pracma/R/eye.R0000644000176200001440000000152111540452742012626 0ustar liggesusers## ## e y e . R Generate basic Matrices ## eye <- function(n, m = n) { stopifnot(is.numeric(n), length(n) == 1, is.numeric(m), length(m) == 1) n <- floor(n) m <- floor(m) if (n <= 0 || m <= 0) return(matrix(NA, 0, 0)) else return(base::diag(1, n, m)) } ones <- function(n, m = n) { stopifnot(is.numeric(n), length(n) == 1, is.numeric(m), length(m) == 1) n <- floor(n) m <- floor(m) if (n <= 0 || m <= 0) return(matrix(1, 0, 0)) else return(matrix(1, n, m)) } zeros <- function(n, m = n) { stopifnot(is.numeric(n), length(n) == 1, is.numeric(m), length(m) == 1) n <- floor(n) m <- floor(m) if (n <= 0 || m <= 0) return(matrix(0, 0, 0)) else return(matrix(0, n, m)) } pracma/R/trapz.R0000755000176200001440000000421312666362554013223 0ustar liggesusers## ## t r a p z . R Numerical integration by trapezoidal rule ## trapz <- function(x, y) { if (missing(y)) { if (length(x) == 0) return(0) y <- x x <- seq(along=x) } if (length(x) == 0 && length(y) == 0) return(0) if (!(is.numeric(x) || is.complex(x)) || !(is.numeric(y) || is.complex(y)) ) stop("Arguments 'x' and 'y' must be real or complex vectors.") m <- length(x) if (length(y) != m) stop("Arguments 'x', 'y' must be vectors of the same length.") if (m <= 1) return(0.0) # z <- sum((x[2:m] - x[1:(m-1)]) * (y[1:(m-1)] + y[2:m])) # return(0.5 * z) xp <- c(x, x[m:1]) yp <- c(numeric(m), y[m:1]) n <- 2*m p1 <- sum(xp[1:(n-1)]*yp[2:n]) + xp[n]*yp[1] p2 <- sum(xp[2:n]*yp[1:(n-1)]) + xp[1]*yp[n] return(0.5*(p1-p2)) } cumtrapz <- function(x, y) { if (missing(y)) { if (length(x) == 0) return(0) y <- x x <- 1:length(x) } if (length(x) == 0) return(0) if (!(is.numeric(x) || is.complex(x)) || !(is.numeric(y) || is.complex(y))) stop("Arguments 'x' and 'y' must be real or complex.") x <- as.matrix(c(x)) m <- length(x) if (is.vector(y)) y <- as.matrix(y) if (nrow(y) != m) stop("Arguments 'x' and 'y' are not compatible: nrow(y) != length(x).") n <- ncol(y) dt <- repmat(diff(x)/2, 1, n) ct <- apply(dt * (y[1:(m-1), ] + y[2:m, ]), 2, cumsum) return(rbind(zeros(1, n), ct)) } trapzfun <- function(f, a, b, maxit = 25, tol = 1e-07, ...) { stopifnot(is.numeric(a), length(a) == 1, is.finite(a), is.numeric(b), length(b) == 1, is.finite(b)) fun <- match.fun(f) f <- function(x) fun(x, ...) if (a == b) return(list(area = 0.0, iter = 0, error = 0)) n <- 1 h <- b - a T <- h * (f(a) + f(b)) / 2.0 for (i in 1:maxit) { M <- 0 for (j in 0:(n-1)) { M <- M + f(a + (j + 0.5) * h) } M <- h * M T <- (T + M) / 2.0 h <- h / 2.0 n <- 2 * n err <- abs(T - M) if (err < tol) break } return(list(value = T, iter = i, rel.err = err)) } pracma/R/haversine.R0000644000176200001440000000456212765332216014043 0ustar liggesusers## ## h a v e r s i n e . R Haversine Formula ## haversine <- function(loc1, loc2, R = 6371.0) { if (is.character(loc1)) { locs <- strsplit(loc1, ',')[[1]] lat1 <- locs[1]; lon1 <- locs[2] lat1 <- .check_coords(lat1) * pi / 180 lon1 <- .check_coords(lon1) * pi / 180 } else if (is.numeric(loc1)) { if (length(loc1) != 2) stop("Coordinate input not in correct format.") lat1 <- loc1[1]; lon1 <- loc1[2] if (abs(lat1) > 90 || abs(lon1) > 180) stop("Coordinate input not in correct format.") lat1 <- lat1 * pi /180; lon1 <- lon1 * pi / 180 } else { stop("Location must be given as string 'lat lon'.") } if (is.character(loc2)) { locs <- strsplit(loc2, ',')[[1]] lat2 <- locs[1]; lon2 <- locs[2] lat2 <- .check_coords(lat2) * pi / 180 lon2 <- .check_coords(lon2) * pi / 180 } else if (is.numeric(loc2)) { if (length(loc2) != 2) stop("Coordinate input not in correct format.") lat2 <- loc2[1]; lon2 <- loc2[2] if (abs(lat2) > 90 || abs(lon2) > 180) stop("Coordinate input not in correct format.") lat2 <- lat2 * pi /180; lon2 <- lon2 * pi / 180 } else { stop("Location must be given as string 'lat, lon'.") } # R <- 6371.0 # average earth radius [km] dlat <- lat2 - lat1 dlon <- lon2 - lon1 # Haversine formula a <- sin(dlat/2)^2 + cos(lat1) * cos(lat2) * sin(dlon/2)^2; c <- 2 * atan2(sqrt(a), sqrt(1-a)) return(R * c) } .check_coords <- function(s) { m <- gregexpr("^\\s*(\\d+)\\s+(\\d+)\\s+(\\d*)\\s*(\\w?)\\s*$", s, perl=TRUE) m <- m[[1]] if (m[1] != 1) stop("Coordinate input not in correct format.") strt <- attr(m, "capture.start") lngt <- attr(m, "capture.length") c1 <- as.numeric( substr(s, strt[1], strt[1]+lngt[1]-1) ) c2 <- as.numeric( substr(s, strt[2], strt[2]+lngt[2]-1) ) c3 <- as.numeric( substr(s, strt[3], strt[3]+lngt[3]-1) ) c0 <- c1 + c2/60 + c3/3600 if (c1 > 180 || c2 >= 60 || c3 >= 60) stop("Coordinate input not in correct format.") c4 <- substr(s, strt[4], strt[4]+lngt[4]-1) if (c4 == 'S' || c4 == 'W') { c0 <- -1 * c0 } else if (c4 != 'N' && c4 != 'E') { stop("Coordinate input not in correct format.") } return(c0) } pracma/R/vectorfield.R0000644000176200001440000000137711567721641014371 0ustar liggesusers## ## v e c t o r f i e l d . R ## vectorfield <- function(fun, xlim, ylim, n = 16, scale = 0.05, col = "green", ...) { stopifnot(is.numeric(xlim), length(xlim) == 2, is.numeric(ylim), length(ylim) == 2) xpts <- linspace(xlim[1], xlim[2], n) ypts <- linspace(ylim[1], ylim[2], n) M <- meshgrid(xpts, ypts) x <- M$X y <- M$Y px = matrix(1, nrow=n , ncol=n) py = fun(x, y); plot(xlim, ylim, type="n"); grid() quiver(x, y, px, py, scale = scale, col = col, ...) } quiver <- function(x, y, u, v, scale = 0.05, angle = 10, length = 0.1, ...) { stopifnot(is.numeric(x), is.numeric(y), is.numeric(u), is.numeric(v)) arrows(x, y, x+scale*u, y+scale*v, angle=10, length=length, ...) } pracma/R/perms.R0000644000176200001440000000161412553102336013171 0ustar liggesusers## ## p e r m s . R Permutations ## perms <- function(a) { n <- length(a) if (length(a) == 0) return(c()) else if (n <= 1) return(matrix(a, 1, 1)) q <- perms(1:(n-1)) # recursive call m <- nrow(q) P <- matrix(0, n*m, n) P[1:m, ] <- cbind(matrix(n, m, 1), q) for (i in (n-1):1) { t <- q t[t == i] <- n P[(m*(n-i)+1):(m*(n-i+1)), ] <- cbind(i*matrix(1, m, 1), t) } b <- a[c(P)] dim(b) <- dim(P) return(b) } randperm <- function(a, k) { n <- length(a) if (n == 0 || a[1] == 0) return(c()) if (n == 1) { if (floor(a) != ceiling(a) || a < 1) stop("Argument 'a' must be a positive integer.") n <- a; a <- 1:a } if (missing(k)) k <- n if (k > n) stop("'k' must be smaller or equal to 'a' or length of 'a'.") m <- sample(a, size = k, replace = FALSE) return(m) } pracma/R/rk4.R0000644000176200001440000000253411567515665012566 0ustar liggesusers## ## r k 4 . R Classical Runge-Kutta ## rk4 <- function(f, a, b, y0, n) { h <- (b-a)/n x <- seq(a+h, b, by = h) y <- numeric(n) k1 <- h * f(a, y0) k2 <- h * f(a + h / 2 , y0 + k1 / 2 ) k3 <- h * f(a + h / 2 , y0 + k2 / 2 ) k4 <- h * f(a + h , y0 + k3) y[1] <- y0 + k1 / 6 + k2 / 3 + k3 / 3 + k4 / 6 for (i in 1:(n-1)) { k1 <- h * f(x[i], y[i]) k2 <- h * f(x[i] + h / 2, y[i] + k1 / 2) k3 <- h * f(x[i] + h / 2 ,y[i] + k2 / 2 ) k4 <- h * f(x[i] + h , y[i] + k3) y[i+1] = y[i] + k1 / 6 + k2 / 3 + k3 / 3 + k4 / 6 } x <- c( a, x) y <- c(y0, y) return(list(x = x, y = y)) } rk4sys <- function(f, a, b, y0, n){ m <- length(y0) h <- (b-a)/n x <- seq(a+h, b, by = h) y <- matrix(0, nrow = n, ncol = m) k1 <- h * f(a, y0) k2 <- h * f(a + h / 2 , y0 + k1 / 2 ) k3 <- h * f(a + h / 2 , y0 + k2 / 2 ) k4 <- h * f(a + h , y0 + k3) y[1, ] <- y0 + k1 / 6 + k2 / 3 + k3 / 3 + k4 / 6 for (i in 1:(n-1)) { k1 <- h * f(x[i], y[i, ]) k2 <- h * f(x[i] + h / 2, y[i, ] + k1 / 2 ) k3 <- h * f(x[i] + h / 2, y[i, ] + k2 / 2) k4 <- h * f(x[i] + h , y[i, ] + k3 ) y[i+1, ] <- y[i, ] + k1 / 6 + k2 / 3 + k3 / 3 + k4 / 6 } x <- c(a, x) y <- rbind(y0, y) return(list(x = x, y = y)) } pracma/R/fft.R0000644000176200001440000000144412074770002012622 0ustar liggesusers## ## f f t . R Fourier Transform ## ifft <- function(x) { if (length(x) == 0) return(c()) if ( (!is.vector(x, mode="numeric") && !is.vector(x, mode="complex"))) stop("Argument 'x' must be real or complex vector.") fft(x, inverse = TRUE) / length(x) } fftshift <- function(x) { stopifnot(is.double(x) || is.complex(x) || is.integer(x)) if (!is.vector(x)) stop("Argument 'x' must be a real or complex vector.") m <- length(x) p <- ceiling(m/2) idx <- c((p+1):m, 1:p) x[idx] } ifftshift <- function(x) { stopifnot(is.double(x) || is.complex(x) || is.integer(x)) if (!is.vector(x)) stop("Argument 'x' must be a real or complex vector.") m <- length(x) p <- floor(m/2) idx <- c((p+1):m, 1:p) x[idx] } pracma/R/trigregress.R0000644000176200001440000000143111566176665014423 0ustar liggesusers## ## t r i g r e g r e s s . R Trigonometric Regression ## trigPoly <- function(x, m) { stopifnot(is.numeric(x), is.numeric(m), length(m) == 1, m >= 0) if (m == 0) return(list(a0 = mean(x), a = c(), b = c())) n <- length(x) t <- seq(0, 2*(n-1)*pi/n, length.out = n) t <- as.matrix(t) a <- b <- numeric(m) for (j in 1:m) { a[j] <- x %*% cos(j*t) b[j] <- x %*% sin(j*t) } a <- 2*a/n b <- 2*b/n a0 <- sum(x)/n if (n == 2*m) a[m] <- a[m]/2 return(list(a0 = a0, a = a, b = b)) } trigApprox <- function(t, x, m) { stopifnot(is.numeric(t)) tP <- trigPoly(x, m) a0 <- tP$a0 a <- tP$a; b <- tP$b y <- a0 for (j in 1:m) { y <- y + a[j]*cos(j*t) + b[j]*sin(j*t) } return(y) } pracma/R/muller.R0000644000176200001440000000274612246147543013362 0ustar liggesusers## ## m u l l e r . R Muller's Method ## muller <- function(f, p0, p1, p2 = NULL, maxiter = 100, tol = 1e-10) { if (is.null(p2)) p2 <- (p0 + p1)/2 stopifnot(is.numeric(p0) || is.complex(p0), length(p0) == 1, is.numeric(p1) || is.complex(p1), length(p1) == 1, is.numeric(p2) || is.complex(p2), length(p2) == 1) f <- match.fun(f) fp0 <- f(p0); fp1 <- f(p1); fp2 <- f(p2) if (!is.finite(fp0) || !is.finite(fp1) || !is.finite(fp2)) stop("Function 'f' not finite at one of the initial points.") # Initialization h1 <- p1 - p0 h2 <- p2 - p1 d1 <- (fp1 - fp0) / h1 d2 <- (fp2 - fp1) / h2 d <- (d2 - d1) / (h2 + h1) # main loop i <- 3 while (i <= maxiter) { b <- d2 + h2*d D <- sqrt(b^2 - 4*f(p2)*d + 0i) if (abs(b - D) < abs(b + D)) { E <- b + D } else { E <- b - D } h <- -2*f(p2) / E p <- p2 + h fp <- f(p) if (abs(h) < tol) break # prepare for next iteration p0 <- p1 p1 <- p2 p2 <- p h1 <- p1 - p0 h2 <- p2 - p1 d1 <- (f(p1) - f(p0)) / h1 d2 <- (f(p2) - f(p1)) / h2 d <- (d2 - d1) / (h2 + h1) i <- i + 1 } if (i > maxiter) warning("Root not found to the desired tolerance.") if (abs(Im(p)) <= 0.1*tol ) { p <- Re(p); fp <- f(p) } return(list(root = p, fval = fp, niter = i, reltol = abs(h))) } pracma/R/interp1.R0000644000176200001440000000664213575517725013454 0ustar liggesusersinterp1 <- function (x, y, xi = x, method = c("linear", "constant", "nearest", "spline", "cubic")) { if (!is.vector(x, mode="numeric") || !is.vector(y, mode="numeric")) stop("Arguments 'x' and 'y' must be numeric vectors.") nx <- length(x) if (length(y) != nx) stop("Arguments 'x' and 'y' must be vectors of the same length.") if (nx <= 1) stop("Arguments 'x', 'y' must have at least a length >= 2.") if (min(xi) < min(x) || max(xi) > max(x)) stop("Points 'xi' outside of range of argument 'x'.") e <- try(method <- match.arg(method), silent = TRUE) if(inherits(e, "try-error")) { warning("Unknown method: will use 'linear' interpolation.") method <- "linear" } if (is.unsorted(x)) { # necessary for method 'nearest' warning("Points in argument in 'x' unsorted; will be sorted.") o <- order(x) x <- x[o]; y <- y[o] } if (any(duplicated(x))) warning("There are duplicated values in 'x'; mean will be tried.") if (method == "constant" || method == "linear") { yi <- approx(x, y, xi, method = method)$y } else if (method == "nearest") { n <- length(x) xx <- c(x[1], (x[2:n] + x[1:(n-1)])/2, x[n]) yy <- c(y, y[n]) yi <- approx(xx, yy, xi, method = "constant")$y } else if (method == "spline") { #spfun <- splinefun(x, y, method = "fmm"); yi <- spfun(xi) yi <- .ml.spline(x, y, xi) } else if (method == "cubic") { yi<- pchip(x, y, xi) } else stop(paste("Method", method, "not yet implemented.")) return(yi) } #-- Moler's spline function -------------------------------- .ml.spline <- function(x, y, xi) { x <- c(x); y <- c(y) n <- length (x) if (length(y) != n) stop("Arguments 'x', 'y' must have the same length.") if (n < 3) stop("spline routine: requires at least 3 points") # First derivatives h <- diff(x) delta <- diff(y)/h d <- .ml.splineslopes(h, delta) # Piecewise polynomial coefficients cc <- (3*delta - 2*d[1:(n-1)] - d[2:n])/h b <- (d[1:(n-1)] - 2*delta + d[2:n])/h^2 # Find subinterval indices k so that x(k) <= xi < x(k+1) m <- length(xi) k <- rep(1, m) for (j in 2:(n-1)) k[x[j] <= xi] <- j # Evaluate spline s <- xi - x[k] v <- y[k] + s*(d[k] + s*(cc[k] + s*b[k])) return(v) } .ml.splineslopes <- function(h, delta) { # Diagonals of tridiagonal system n <- length(h)+1 a <- numeric(length(h)) b <- a; cc <- a; r <- a a[1:(n-2)] <- h[2:(n-1)] a[n-1] <- h[n-2] + h[n-1] b[1] <- h[2] b[2:(n-1)] <- 2*(h[2:(n-1)] + h[1:(n-2)]) b[n] <- h[n-2] cc[1] <- h[1] + h[2] cc[2:(n-1)] <- h[1:(n-2)] # Right-hand side r[1] <- ((h[1] + 2*cc[1]) * h[2]*delta[1] + h[1]^2 * delta[2])/cc[1] r[2:(n-1)] <- 3 * (h[2:(n-1)] * delta[1:(n-2)] + h[1:(n-2)] * delta[2:(n-1)]) r[n] <- (h[n-1]^2 * delta[n-2] + (2*a[n-1] + h[n-1]) * h[n-2] * delta[n-1])/a[n-1] # Solve tridiagonal linear system d <- .ml.tridisolve(a, b, cc, r) return(d) } .ml.tridisolve <- function(a, b, cc, d) { x <- d n <- length(x) for (j in 1:(n-1)) { mu <- a[j]/b[j] b[j+1] <- b[j+1] - mu*cc[j] x[j+1] <- x[j+1] - mu*x[j] } x[n] <- x[n]/b[n] for (j in (n-1):1) x[j] <- (x[j]-cc[j]*x[j+1])/b[j] return(x) } pracma/R/compan.R0000755000176200001440000000100213462656464013332 0ustar liggesusers### ### COMPAN.R Polynom ### compan <- function(p) { if (length(p) == 0) return(c()) if ( !is.vector(p, mode="numeric") && (!is.vector(p, mode="complex")) ) stop("Argument p must be a vector of real or complex numbers.") while(p[1] == 0 && length(p) >= 2) { p <- p[2:length(p)] } n <- length(p) if (n <= 1) { a <- c() } else { if (n == 2) { a <- -p[2]/p[1] } else { a <- diag(0, n-1, n-1) for (i in 2:(n-1)) { a[i, i-1] <- 1 } a[1, ] <- -p[2:n]/p[1] } } return(a) } pracma/R/randortho.R0000644000176200001440000000115114152462474014050 0ustar liggesusers## ## r a n d o r t h o . R Generate Random Orthogonal Matrix ## randortho <- function(n, type = c("orthonormal", "unitary")) { stopifnot(is.numeric(n), length(n) == 1, floor(n) == ceiling(n), n >= 1) if (n == 1) return(matrix(1, 1, 1)) type <- match.arg(type) if (type == "orthonormal") { z <- randn(n, n) / sqrt(2.0) } else { z <- (randn(n, n) + 1i * randn(n, n)) / sqrt(2.0) } # QR decomposition for real or complex matrices Z <- qr(z) q <- qr.Q(Z); r <- qr.R(Z) d <- diag(r) ph <- d/abs(d) q %*% diag(ph) } pracma/R/invlap.R0000644000176200001440000000160412001565513013331 0ustar liggesusers## ## i n v l a p . R Inverse Laplacian ## invlap <- function(Fs, t1, t2, nnt, a = 6, ns = 20, nd = 19) { stopifnot(is.numeric(t1), length(t1) == 1, is.numeric(t2), length(t2) == 1, is.numeric(nnt), length(nnt) == 1) Fs <- match.fun(Fs) radt <- linspace(t1, t2, nnt) if (t1 == 0) { radt <- radt[2:nnt] nnt <- nnt - 1 } alfa <- beta <- numeric(ns+1+nd) for (n in 1:(ns+1+nd)) { alfa[n] <- a + (n-1) * pi * 1i beta[n] <- -exp(a) * (-1)^n } n <- 1:nd bdif <- rev(cumsum(gamma(nd+1) / gamma(nd+2-n) / gamma(n))) / 2^nd beta[(ns+2):(ns+1+nd)] <- beta[(ns+2):(ns+1+nd)] * bdif beta[1] = beta[1]/2 ft <- numeric(nnt) for (kt in 1:nnt) { tt <- radt[kt] s <- alfa/tt bt <- beta/tt btF <- bt * Fs(s) ft[kt] <- sum(Re(btF)) } return(list(x = radt, y = ft)) } pracma/R/fprintf.R0000644000176200001440000000035112763544663013530 0ustar liggesusers## ## f p r i n t f . R Formatted printing to stdout or file ## fprintf <- function(fmt, ..., file = "", append = FALSE) { mystr <- sprintf(fmt, ...) cat(mystr, file = file, append = append) invisible(nchar(mystr)) } pracma/R/newtonsys.R0000644000176200001440000000141312101433324014102 0ustar liggesusers## ## n e w t o n s y s . R ## # Finds a zero of a nonlinear system by Newton's method newtonsys <- function(Ffun, x0, Jfun = NULL, ..., maxiter = 100, tol = .Machine$double.eps^(1/2)) { .vnorm <- function(x) { sqrt(sum(x^2)) } if (is.null(Jfun)) Jfun <- function(x, ...) jacobian(Ffun, x, ...) niter <- 0; err <- tol + 1 x <- x0 while (err >= tol && niter < maxiter) { niter <- niter + 1 F <- Ffun(x, ...) J <- Jfun(x, ...) delta <- -1 * solve(J, F) x <- x + delta err <- .vnorm(delta) } F <- .vnorm(Ffun(x, ...)) if (niter > maxiter && err > tol) { cat("Fails to converge within maximum number of iterations.\n", "The iterate returned has relative residual ", F, "\n", sep="") } return(list(zero=x, fnorm=F, niter=niter)) } pracma/R/hessenberg.R0000644000176200001440000000170313361375005014172 0ustar liggesusershessenberg <- function(A) { stopifnot(is.numeric(A), is.matrix(A)) m <- nrow(A); n <- ncol(A) if (m != n) stop("Input 'A' must be a square matrix.") if (n <= 2) { return(list(H = A, P = eye(n))) } # initialize variables H <- A V <- vector(mode = "list", length = n-2) # Householder transformation for (k in 1:(n-2)) { v <- H[(k+1):n, k] sgn <- sign(v[1]) if (sgn == 0) sgn <- 1 v[1] <- v[1] + sgn * Norm(v) if (Norm(v) != 0) v <- v / Norm(v) H[(k+1):n,k:n] <- H[(k+1):n, k:n] - 2 * v %*% (t(v) %*% H[(k+1):n,k:n]) H[ ,(k+1):n] <- H[ , (k+1):n] - (2 * (H[ , (k+1):n] %*% v)) %*% t(v) V[[k]] <- v } Q <- eye(n) for (j in (n-2):1) { Q[(j+1):n, ] <- Q[(j+1):n, ] - (2 * V[[j]]) %*% (t(V[[j]]) %*% Q[(j+1):n, ]) } return(list(H = H, P = Q)) }pracma/R/savgol.R0000644000176200001440000000135512054177676013357 0ustar liggesusers## ## s a v g o l . R Savitzky-Golay Smoothing ## savgol <- function(T, fl, forder = 4, dorder = 0) { stopifnot(is.numeric(T), is.numeric(fl)) if (fl <= 1 || fl %% 2 == 0) stop("Argument 'fl' must be an odd integer greater than 1.") n <- length(T) # -- calculate filter coefficients -- fc <- (fl-1)/2 # index: window left and right X <- outer(-fc:fc, 0:forder, FUN="^") # polynomial terms and coeffs Y <- pinv(X); # pseudoinverse # -- filter via convolution and take care of the end points -- T2 <- convolve(T, rev(Y[(dorder+1),]), type="o") # convolve(...) T2 <- T2[(fc+1):(length(T2)-fc)] Tsg <- (-1)^dorder * T2 return( Tsg ) } pracma/R/cubicspline.R0000644000176200001440000000204412001517521014333 0ustar liggesusers## ## c u b i c s p l i n e . R Interpolating Cubic Spline ## cubicspline <- function(x, y, xi = NULL, endp2nd = FALSE, der = c(0, 0)) { n <- length(x) h <- x[2:n] - x[1:(n-1)] e <- 2 * c(h[1], h[1:(n-2)] + h[2:(n-1)], h[n-1]) A <- Diag(e) + Diag(h, -1) + Diag(h, 1) d <- (y[2:n] - y[1:(n-1)]) / h rhs <- 3* (d[2:(n-1)] - d[1:(n-2)]) der0 <- der[1]; dern <- der[2] if (endp2nd) { A[1, 1] <- 2 * h[1]; A[1, 2] <- h[1] A[n, n] <- 2 * h[n-1]; A[n-1, n-2] <- h[n-1] rhs <- c(3*(d[1] - der0), rhs, 3*(dern - d[n-1])) } else { A[1, ] <- 0; A[1, 1] <- 1 A[n, ] <- 0; A[n, n] <- 1 rhs <- c(der0, rhs, dern) } S <- zeros(n, 4) S[, 3] <- solve(A, rhs) for (m in 1:(n-1)) { S[m,4] = (S[m+1,3]-S[m,3]) / 3 / h[m] S[m,2] = d[m] - h[m]/3 * (S[m + 1,3] + 2*S[m,3]) S[m,1] = y[m] } S <- S[1:(n-1), 4:1] pp <- mkpp(x, S) if (is.null(xi)) { return(pp) } else { yi <- ppval(pp,xi) return(yi) } } pracma/R/agmean.R0000644000176200001440000000163012367744414013305 0ustar liggesusers## ## a g m e a n . R Arithmetic-geometric Mean ## agmean <- function(a, b) { eps <- .Machine$double.eps stopifnot(is.numeric(a) || is.complex(a), is.numeric(b) || is.complex(b)) if (is.numeric(a) && any(a < 0) || is.numeric(b) && any(b < 0)) { a <- as.complex(a) b <- as.complex(b) } if (length(a) == 1) { n <- length(b) a <- rep(a, n) } else if (length(b) == 1) { n <- length(a) b <- rep(b, n) } else if (length(a) != length(b)) stop("Arguments must have the same length or one has length 1.") niter = 0 while ( any(abs(a-b) >= eps) ) { niter = niter + 1 a1 <- (a + b) / 2 b1 <- sqrt(a * b) if (max(abs(a-a1)) < eps && max(abs(b-b1)) < eps) break a <- a1 b <- b1 } return( list(agm = (a+b)/2, niter = niter, prec = max(abs(b-a))) ) } pracma/R/clear.R0000644000176200001440000000435112072652461013137 0ustar liggesusers## ## c l e a r . R ## clear <- function(lst) { if (missing(lst)) lst <- ls(name = .GlobalEnv) if (!is.character(lst)) stop("Argument must be empty or a character vector.") rm(list = lst, envir = globalenv()) # capture.output(gc()) null <- gc() } who <- function() ls(name = .GlobalEnv) whos <- function() { envir <- parent.frame() lslist <- ls(envir) if (isempty(lslist)) return(invisible(NULL)) m <- max(nchar(lslist)) for (item in lslist) { itemObj <- eval(parse(text = item), parent.frame()) itemClass <- class(itemObj) itemSize <- object.size(itemObj) itemDim <- paste(dim(itemObj), collapse="x") if (itemDim == '') itemDim <- length(itemObj) itemSize <- as.numeric(itemSize) if (itemSize < 1024) itemSize <- paste(itemSize, "Byte") else if (itemSize >= 1024 & itemSize < 1024*1024) itemSize <- paste(round(itemSize/1024, 1), "KB") else itemSize <- paste(round(itemSize/1024/1024, 1), "MB") format(cat( item, blanks(m - nchar(item) + 2), itemClass, ", ", itemDim, ", ", itemSize, "\n", sep=""), justify="centre") } cat("\n") invisible(lslist) } what <- function(dname = getwd()) { # , fexp = "*.R" if (is.na(file.info(dname)$isdir)) { cat("Argument '", dname, "' is not a known directory.\n", sep = '') } else if (file.info(dname)$isdir) { fnames <- list.files(dname) if (isempty(fnames)) { cat("No files in Directory ", dname, ".\n\n", sep = '') } else { cat("Files in Directory ", dname, ":\n\n", sep = '') for (fname in fnames) { gname <- paste(dname, fname, sep = "/") if (!file.info(gname)$isdir) { cat(fname, "\n") } } } } else { cat("Argument '", dname, "' is not a directory.\n", sep = '') } invisible(NULL) } cd <- function(dname) { if (missing(dname)) { dname <- getwd() } else { setwd(dname) dname <- getwd() } return(dname) } pwd <- function() getwd() pracma/R/combs.R0000644000176200001440000000113711540452742013152 0ustar liggesusers## ## c o m b s . R Combinations ## combs <- function(a, m){ n <- length(a) if (length(a) == 0 || m <= 0) return(c()) if (m >= n) return(a) if (m <= 1) return(matrix(a, n, 1)) v <- c(a) P <- c() for (k in 1:(n-m)) { Q <- combs(v[(k+1):n], m-1) P <- rbind(P, cbind(v[k], Q)) } k <- n-m+1 Q <- combs(v[(k+1):n], m-1) P <- rbind(P, c(v[k], Q)) b <- a[c(P)] dim(b) <- dim(P) return(P) } randcomb <- function(a, m) { n <- length(a) if (n == 0) return(c()) m <- sample(1:n, size = m, replace = FALSE) return(a[m]) } pracma/R/l1linreg.R0000644000176200001440000000166212214146052013560 0ustar liggesusers## ## l 1 l i n r e g . R ## L1linreg <- function(A, b, p = 1, tol = 1e-07, maxiter = 200) { stopifnot(is.numeric(A), is.numeric(b)) if (is.vector(A)) A <- as.matrix(A) n <- nrow(A); m <- ncol(A) b <- c(b) if (length(b) != n) stop("Arguments 'A' and 'b' are not compatible.") if (p > 1) stop("Argument 'p' must be smaller or equal to 1.") B <- Bold <- qr.solve(A, b) Bold[1] <- Bold[1] + 10*tol iter <- 1 while (max(abs(B - Bold)) > tol && iter <= maxiter) { Bold <- B e <- c( pmax(abs(A %*% Bold - b), tol) ) if (p == 1) { w <- sqrt(1/e) } else { w <- sqrt(e^(p-2)) } B <- c(qr.solve(diag(w) %*% A, w * b)) iter <- iter + 1 } if (iter > maxiter) warning("Reached max. no. of iterations; may not have converged.") return(list(x = B, reltol = max(abs(B - Bold)), niter = iter)) } pracma/R/quadprog.R0000644000176200001440000000461713204365100013665 0ustar liggesusers## ## q u a d p r o g . R Quadratic Programming ## quadprog <- function( C, d, # min! 1/2 x'Cx + d'x A = NULL, b = NULL, # A x <= b Aeq = NULL, beq = NULL, # Aeq x == beq lb = NULL, ub = NULL) # lb <= x <= ub { if (!requireNamespace("quadprog", quietly = TRUE)) { stop("quadprog needed for this function to work. Please install it.", call. = FALSE) } stopifnot(is.numeric(C), is.matrix(C), is.numeric(d), is.vector(d)) if (is.null(A) && !is.null(b) || !is.null(A) && is.null(b)) stop("If any, both 'A' and 'b' must be NULL.") if (is.null(Aeq) && !is.null(beq) || !is.null(Aeq) && is.null(beq)) stop("If any, both 'Aeq' and 'beq' must be NULL.") if (any(C != t(C))) warning("Argument 'C' is not a symmetric matrix.") if (any(eigen(C)$values <= 0)) warning("Matrix 'C' is not positive definite.") # check matrix sizes for C, A, and Aeq mc <- nrow(C); nc <- ncol(C); n <- nc if (mc != nc) stop("Argument 'C' must be a quadratic matrix") if (length(d) != nc) stop("Dimensions of 'C' and 'd' do not fit.") if (is.null(Aeq)) { meq <- 0 } else if (is.vector(Aeq)) { Aeq <- matrix(Aeq, 1) meq <- 1 } else { meq <- nrow(Aeq) } if (!is.null(Aeq) && ncol(Aeq) != n) stop("Dimensions of 'C' and 'Aeq' do not fit.") # check lower and upper bounds if (is.null(lb)) { diag_lb <- NULL } else { if (length(lb) == 1) { lb <- rep(lb, n) } else if (length(lb) != n) { stop("Length of 'lb' and dimensions of C do not fit.") } diag_lb <- diag(n) } if (is.null(ub)) { diag_ub <- NULL } else { if (length(ub) == 1) { ub <- rep(ub, n) } else if (length(ub) != n) { stop("Length of 'ub' and dimensions of C do not fit.") } diag_ub <- -diag(n) # quadprog requires -x >= -ub ub <- -ub } # collect all constraints into one matrix H and vector if (!is.null(A)) { A <- -A b <- -b } H <- rbind(Aeq, A, diag_lb, diag_ub) f <- c(beq, b, lb, ub) qps <- quadprog::solve.QP(C, -d, t(H), f, meq = meq) eflag <- 0 if (all(C == t(C)) && all(eigen(C)$values > 0)) eflag <- 1 list(xmin = qps$solution, fval = qps$value, eflag = eflag) } pracma/R/chebyshev.R0000644000176200001440000000274611552371733014041 0ustar liggesusers## ## c h e b y s h e v . R ## chebPoly <- function(n, x = NULL) { stopifnot(is.numeric(n), length(n) == 1, floor(n) == ceiling(n), n >= 0) N <- max(2, n+1) T <- matrix(0, N, N) # Preset degree 0 and 1 T[1, 1] <- 1 T[2, 2] <- 1 # Use recursion formula if (n >= 2) for (i in 3:N) T[i, ] <- 2 * c(0, T[i-1, 1:(N-1)]) - T[i-2, ] # Reverse with highest coefficient first T <- T[ ,ncol(T):1] if (is.null(x)) { return(T) } else if (is.numeric(x)) { return(polyval(T[n+1, ], x)) } else stop("Argument 'x' must be a numeric vector.") } chebCoeff <- function(fun, a, b, n) { N <- n+1 # Map interval [a, b] to [-1, 1] c1 <- 0.5*(b-a) c2 <- 0.5*(b+a) # Evaluate function at Chebyshev points (in [a, b]) k <- c(0:(N-1)) y <- cos(pi*(k+0.5)/N) fy <- fun(c1*y + c2) # Now compute the Chebyshev coefficients c0 <- 2.0 / N K <- matrix(k+0.5, N, 1) cheb <- c0 * fy %*% cos(pi/N * K %*% k) # Remove too small coefficients and return eps <- 2 * .Machine$double.eps # machine precision cheb <- ifelse(abs(cheb) < eps, 0, cheb) return(drop(cheb)) } chebApprox <- function(x, fun, a, b, n) { # Compute the Chebyshev polynomials of fun in [a, b] cP <- chebPoly(n) cC <- chebCoeff(fun, a, b, n) p <- drop(cC %*% cP) c0 <- cC[1] # Map x into [-1, 1] and evaluate the Chebyshev polynomial xx <- (2*x - (b+a))/(b-a) yy <- polyval(p, xx) - c0/2 return(yy) } pracma/R/fornberg.R0000644000176200001440000000277511744617426013674 0ustar liggesusersfornberg <- function(x, y, xs, k = 1) { stopifnot(is.numeric(x), is.numeric(y), is.numeric(xs)) if (any(is.na(y))) { inna <- which(!is.na(y)) x <- x[inna]; y <- y[inna] } n <- length(x); l <- length(xs) if (length(unique(x)) != n) stop("All elements in vector 'x' must be different.") if (k >= n) stop("Length of 'x' must be greater than k.") if (k <= 0) stop("Order 'k' must be between 1 and length of 'x'.") m <- k Y <- matrix(NA, nrow = l, ncol = k+1) for (ij in 1:l) { x0 <- xs[ij] c1 <- 1 c4 <- x[1] - x0 C <- zeros(n, m+1) C[1,1] <- 1 for (i in 1:(n-1)) { i1 <- i+1 mn <- min(i,m) c2 <- 1 c5 <- c4 c4 <- x[i1] - x0 for (j in 0:(i-1)) { j1 <- j+1 c3 <- x[i1] - x[j1] c2 <- c2*c3 if (j == i-1) { for (s in mn:1) { s1 <- s+1 C[i1,s1] <- c1*(s*C[i1-1,s1-1] - c5*C[i1-1,s1])/c2 } C[i1,1] <- -c1*c5*C[i1-1,1]/c2 } for (s in mn:1) { s1 <- s+1 C[j1,s1] <- (c4*C[j1,s1] - s*C[j1,s1-1])/c3 } C[j1,1] <- c4*C[j1,1]/c3 } c1 <- c2 } Y[ij, ] <- y %*% C } if (k == 0) Y <- Y[, 1, drop = FALSE] return(Y) } pracma/R/deconv.R0000644000176200001440000000124611563500200013312 0ustar liggesusers## ## d e c o n v . R Deconvolution ## deconv <- function(b, a) { if (length(b) == 0) return(list(q = 0, r = c())) if ( (!is.numeric(b) && ! is.complex(b)) || (!is.numeric(a) && ! is.complex(a)) ) stop("Arguments 'b' and 'a' must be numeric or complex.") if ( a[1] == 0) stop("First element of argument 'a' must be nonzero.") nb <- length(b) na <- length(a) if (nb < na) return(list(q = 0, r = b)) q <- c() while (nb >= na) { d <- b[1] / a[1] b <- b - conv(a, c(d, rep(0, nb-na))) q <- c(q, d) b <- b[2:nb] nb <- nb -1 } return(list(q = q, r = b)) } pracma/R/nearest_spd.R0000644000176200001440000000172113575517725014372 0ustar liggesusersnearest_spd <- function(A) { stopifnot(is.numeric(A), is.matrix(A)) eps <- .Machine$double.eps m <- nrow(A); n <- ncol(A) if (m != n) { stop("Argument 'A' must be a square matrix.") } else if (n == 1 && A <= 0) return(as.matrix(eps)) B <- (A + t(A)) / 2 # symmetrize A svdB <- svd(B) # H is symmetric polar factor of B H <- svdB$v %*% diag(svdB$d) %*% t(svdB$v) Ahat <- (B + H) / 2 Ahat <- (Ahat + t(Ahat)) / 2 # Test that Ahat is in fact positive-definite; # if it is not so, then tweak it just a bit. k <- 0; not_pd <- TRUE while (not_pd) { k <- k + 1 try_R <- try(chol(Ahat), silent = TRUE) if(inherits(try_R, "try-error")) { mineig <- min(eigen(Ahat, symmetric = TRUE, only.values = TRUE)$values) Ahat = Ahat + (-mineig*k^2 + eps(mineig)) * diag(1, n) } else not_pd <- FALSE } Ahat } pracma/R/fmincon.R0000644000176200001440000000504413400317701013471 0ustar liggesusers## ## f m i n c o n . R ## fmincon <- function(x0, fn, gr = NULL, ..., method = "SQP", A = NULL, b = NULL, Aeq = NULL, beq = NULL, lb = NULL, ub = NULL, hin = NULL, heq = NULL, tol = 1e-06, maxfeval = 10000, maxiter = 5000) { if (method != "SQP") stop("Methods other than 'SQP' are not yet implemented.") if (!is.numeric(x0) || length(x0) <= 1) stop("'x0' must be a numeric vector of length greater 1.") if (!is.null(gr)) warning("Gradient function is not used for SQP approach.") if (!requireNamespace("NlcOptim", quietly =TRUE)) stop("Package 'NlcOptim' missing -- install from CRAN.") if (!requireNamespace("quadprog", quietly =TRUE)) stop("Package 'quadprog' missing -- install from CRAN.") fun <- match.fun(fn) fn <- function(x) fun(x, ...) if (!is.null(A)) { if (!is.matrix(A) || ncol(A) != length(x0)) stop("Argument 'A' must be a matrix with length(x0) columns.") if (is.null(b) || nrow(A) != length(b)) stop("Argument 'b' must be a vector of length(b) = nrow(A).") } if (!is.null(Aeq)) { if (!is.matrix(Aeq) || ncol(Aeq) != length(x0)) stop("Argument 'Aeq' must be a matrix with length(x0) columns.") if (is.null(beq) || nrow(Aeq) != length(beq)) stop("Argument 'beq' must be a vector of length(beq) = nrow(Aeq).") } if (!is.null(lb) && length(lb) != length(x0)) { if (length(lb == 1)) lb <- rep(lb, length(x0)) else stop("Length of argument 'lb' must be equal to length(x0).") } if (!is.null(ub) && length(ub) != length(x0)) { if (length(ub == 1)) ub <- rep(ub, length(x0)) else stop("Length of argument 'ub' must be equal to length(x0).") } if (is.null(hin) && is.null(heq)) { confun = NULL } else if (is.null(heq)) { confun <- function(x) list(ceq = NULL, c = hin(x)) } else if (is.null(hin)) { confun <- function(x) list(ceq = heq(x), c = NULL) } else confun <- function(x) list(ceq = heq(x), c = hin(x)) sol <- NlcOptim::solnl(X = x0, objfun = fn, confun = confun, A = A, B = b, Aeq = Aeq, Beq = beq, lb = lb, ub = ub, tolX = tol, tolFun = 0.1*tol, tolCon = 0.1*tol) ans <- list(par = c(sol$par), value = sol$fn, convergence = 0, info = list(lambda = sol$lambda, grad = sol$grad, hessian = sol$hessian)) return(ans) } pracma/R/kron.R0000644000176200001440000000044311540452742013017 0ustar liggesusers## ## k r o n . R Kronecker product ## kron <- function(a, b) { if (length(a) == 0 || length(b) == 0) return(c()) if (!(is.numeric(a) || is.complex(a)) || !(is.numeric(b) || is.complex(b))) stop("Arguments 'a' and 'b' must be real/complex vectors/matrices.") kronecker(a, b) } pracma/R/ode45.R0000644000176200001440000000621112353745103012764 0ustar liggesusers## ## o d e 5 4 . R ODE Solver ## ode45 = function(f, t0, tfinal, y0, ..., atol = 1e-6, hmax = 0.0) { stopifnot(is.numeric(y0), is.numeric(t0), length(t0) == 1, is.numeric(tfinal), length(tfinal) == 1) if (is.vector(y0)) { y0 <- as.matrix(y0) } else if (is.matrix(y0) && ncol(y0) != 1) { stop("Argument 'y0' must be a vector or single column matrix.") } fun <- match.fun(f) f <- function(t, y) fun(t, y, ...) pow <- 1/6 # see p.91 in Ascher & Petzold nsteps <- 1e3 * (tfinal - t0) # estimated number of steps if (hmax == 0.0) hmax <- (tfinal - t0)/2.5 # max stepsize # Define the Dormand-Prince 4(5) coefficients dp = matrix(c(0, 0, 0, 0, 0, 0, 1/5, 0, 0, 0, 0, 0, 3/40, 9/40, 0, 0, 0, 0, 44/45, -56/15, 32/9, 0, 0, 0, 19372/6561, -25360/2187, 64448/6561, -212/729, 0, 0, 9017/3168, -355/33, 46732/5247, 49/176, -5103/18656, 0, 35/384, 0, 500/1113, 125/192, -2187/6784, 11/84), nrow = 7, ncol = 6, byrow=TRUE) b4 = c(5179/57600, 0, 7571/16695, 393/640, -92097/339200, 187/2100, 1/40) b5 = c(35/384, 0, 500/1113, 125/192, -2187/6784, 11/84, 0) cc = rowSums(dp) # Initialization t <- t0 hmin <- (tfinal - t)/1e20 h <- (tfinal - t)/100 # initial step size guess x <- as.matrix(y0) # ensure x is a column vector nstates <- size(x,1) tout <- zeros(nsteps, 1) # preallocating memory xout <- zeros(nsteps, nstates) nsteps_rej <- 0 nsteps_acc <- 1 tout[nsteps_acc] <- t # first output time xout[nsteps_acc,] <- x # first output solution = IC's # Main loop using Dormand-Prince 4(5) pair kk <- x %*% zeros(1, 7) kk[, 1] <- f(t, x) while (t < tfinal && h >= hmin) { if (t + h > tfinal) h <- tfinal - t for (j in 1:6) kk[, j+1] <- f(t + cc[j+1]*h, x + h*kk[, 1:j] %*% as.matrix(dp[j+1, 1:j])) # compute the 4th and 5th order estimates x4 <- x + h * (kk %*% b4) x5 <- x + h * (kk %*% b5) # estimate the errors gamma1 <- x5 - x4 # local truncation error delta = Norm(gamma1, Inf); # actual error tau = atol * max(Norm(x, Inf), 1.0) # allowable error # update solution only if the error is acceptable if (delta < tau) { t = t + h x = x5 # "local extrapolation" nsteps_acc <- nsteps_acc + 1 tout[nsteps_acc] <- t xout[nsteps_acc, ] <- x kk[, 1] <- kk[, 7] } else { # unacceptable integration step nsteps_rej <- nsteps_rej + 1 } # update the step size if (delta == 0.0) delta <- 1e-16 h <- min(hmax, 0.8 * h * (tau/delta)^pow) } # Trim output if (nsteps_acc < nsteps) { tout <- tout[1:nsteps_acc] xout <- xout[1:nsteps_acc, ] } if (t < tfinal) warning("Step size grew too small.") return(list(t = tout, y = xout)) } pracma/R/inv.R0000644000176200001440000000072713575517725012664 0ustar liggesusers## ## i n v . R matrix inverse ## inv <- function(a) { if (length(a) == 0) return(matrix(0, nrow=0, ncol=0)) if ((!is.numeric(a) && !is.complex(a)) || !is.matrix(a)) stop("Argument 'a' must be a numeric or complex matrix.") if (nrow(a) != ncol(a)) stop("Matrix 'a' must be square.") e <- try(b <- solve(a), silent=TRUE) if(inherits(e, "try-error")) { warning("Matrix appears to be singular.") b <- rep(Inf, length(a)) dim(b) <- dim(a) } return(b) } pracma/R/isprime.R0000755000176200001440000000112011540452742013512 0ustar liggesusers### ### ISPRIME.R Prime number property ### isprime <- function(x) { if (is.null(x) || length(x) == 0) stop("Argument 'x' must be a nonempty vector or matrix.") if (!is.numeric(x) || any(x < 0) || any(x != round(x))) stop("All entries of 'x' must be nonnegative integers.") n <- length(x) X <- x[1:n] L <- logical(n) p <- primes(ceiling(sqrt(max(x)))) for (i in 1:n) { L[i] <- all(X[i] %% p[p < X[i]] != 0) # all(rem(X[k], p[p < X[k]])) } L[X == 1 | X == 0] <- FALSE N <- as.numeric(L) dim(N) <- dim(x) return(N) } pracma/R/inpolygon.R0000644000176200001440000000240511565176163014073 0ustar liggesusers## ## i n p o l y g o n . R Polygon Interior ## inpolygon <- function(x, y, xp, yp, boundary = FALSE) { stopifnot(is.numeric(x), is.numeric(y), length(x) == length(y), is.numeric(xp), is.numeric(yp), length(xp) == length(yp)) # xmin <- min(xp); xmax <- max(xp) # exclude all points 'far' outside # ymin <- min(yp); ymax <- max(yp) n <- length(x) np <- length(xp) # Polygon must be closed if (xp[1] != xp[np] || yp[1] != yp[np]) { xp <- c(xp, xp[1]) yp <- c(yp, yp[1]) np <- np + 1 } inpoly <- rep(FALSE, n) onpoly <- rep(FALSE, n) j <- np for (i in 1:np) { dxp <- xp[j] - xp[i] dyp <- yp[j] - yp[i] dist <- dxp * (y - yp[i]) - (x - xp[i]) * dyp idx1 <- ( ((yp[i] <= y & y < yp[j]) | (yp[j] <= y & y < yp[i])) & (0 < dist * dyp) ) inpoly[idx1] <- !inpoly[idx1] idx2 <- ( ((yp[i] <= y & y <= yp[j]) | (yp[j] <= y & y <= yp[i])) & ((xp[i] <= x & x <= xp[j]) | (xp[j] <= x & x <= xp[i])) & (0 == dist | !dxp) ) onpoly[idx2] <- TRUE j <- i } if (boundary) inpoly[onpoly] <- TRUE else inpoly[onpoly] <- FALSE return(inpoly) } pracma/R/erf.R0000644000176200001440000000731513574516673012644 0ustar liggesusers## ## e r r o r f . R Error functions (Matlab Style) ## # Error function erf <- function(x) { # 2*pnorm(sqrt(2)*x)-1 pchisq(2*x^2,1)*sign(x) } # Inverse error function erfinv <- function(y) { y[abs(y) > 1] <- NA sqrt(qchisq(abs(y),1)/2) * sign(y) } # Complementary error function erfc <- function(x) { # 1 - erf(x) 2 * pnorm(-sqrt(2) * x) } # Inverse complementary error function erfcinv <- function(y) { y[y < 0 | y > 2] <- NA -qnorm(y/2)/sqrt(2) } # Scaled complementary error function erfcx <- function(x) { exp(x^2) * erfc(x) } # Complex error function erfz <- function(z) { if (is.null(z)) return( NULL ) else if (!is.numeric(z) && !is.complex(z)) stop("Argument 'z' must be a numeric or complex scalar or vector.") a0 <- abs(z) c0 <- exp(-z * z) z1 <- ifelse (Re(z) < 0, -z, z) i <- a0 <= 5.8 work.i <- i cer <- rep(NA, length = length(z)) if ( sum(work.i) > 0) { cs <- z1 cr <- cs for (k in 1:120) { cr[work.i] <- cr[work.i] * z1[work.i] * z1[work.i]/(k + 0.5) cs[work.i] <- cs[work.i] + cr[work.i] work.i <- work.i & (abs(cr/cs) >= 1e-15) if (sum(work.i) == 0) break } cer[i] <- 2 * c0[i] * cs[i]/sqrt(pi) } work.i <- !i if( sum(work.i) > 0) { cl <- 1/z1 cr <- cl for (k in 1:13) { cr[work.i] <- -cr[work.i] * (k - 0.5)/(z1[work.i] * z1[work.i]) cl[work.i] <- cl[work.i] + cr[work.i] work.i <- work.i & (abs(cr/cl) >= 1e-15) if (sum(work.i) == 0) break } cer[!i] <- 1 - c0[!i] * cl[!i]/sqrt(pi) } cer[ Re(z) < 0] <- -cer[ Re(z) < 0] return(cer) } # Imaginary error function erfi <- function(z) { if (length(z) == 0) return(c()) else if (length(z) == 1) { if (is.na(z)) return(NA) else if (z == 0) return(0.0) else if (is.numeric(z)) return(Re(-1i * erfz(1i * z))) else if (is.complex(z)) return(-1i * erfz(1i * z)) else stop("Argument 'z' must be a numeric or complex scalar or vector.") } else { return(sapply(z, erfi)) } } #-- Error function for real values # erf <- function(x) { # eps <- .Machine$double.eps # pi <- 3.141592653589793 # x2 <- x * x # if (abs(x) < 3.5) { # er <- 1.0 # r <- 1.0 # for (k in 1:50) { # r <- r * x2 / (k+0.5) # er <- er+r # if (abs(r) < abs(er)*eps) break # } # c0 <- 2.0 / sqrt(pi) * x * exp(-x2) # err <- c0 * er # } else { # er <- 1.0 # r <- 1.0 # for (k in 1:12) { # r<- -r * (k-0.5) / x2 # er <- er + r # } # k <- 12+1 # c0 <- exp(-x2) / (abs(x) * sqrt(pi)) # err <- 1.0 - c0 * er # if (x < 0.0) err <- -err # } # return(err) # } #-- Error function for complex values # erfz <- function(z) { # if (is.null(z) || length(z) != 1) # stop("Argument 'z' must be single complex value.") # # a0 <- abs(z); # c0 <- exp(-z*z) # # z1 <- if (Re(z) < 0.0) -z else z # # if(a0 <= 5.8) { # cs <- z1 # cr <- cs # for (k in 1:120) { # cr <- cr * z1 * z1 / (k+0.5) # cs <- cs + cr # if (abs(cr/cs) < 1.0e-15) break # } # cer <- 2.0 * c0 * cs / sqrt(pi) # # } else { # cl <- 1.0 / z1 # cr <- cl # for (k in 1:13) { # cr <- -cr * (k-0.5) / (z1 * z1) # cl <- cl + cr # if (abs(cr/cl) < 1.0e-15) break # } # cer <- 1.0 - c0 * cl / sqrt(pi) # } # # if(Re(z)< 0.0) cer <- -cer # # return(cer) # } pracma/R/numderiv.R0000644000176200001440000000273712274047002013701 0ustar liggesusers## ## n u m d e r i v . R Richardson Numerical Derivative ## numderiv <- function(f, x0, maxiter = 16, h = 1/2, ..., tol = .Machine$double.eps) { if (length(x0) != 1 || !is.numeric(x0)) stop("Argument 'x0' must be a numeric scalar.") fun <- match.fun(f) f <- function(x) fun(x, ...) if (length(f(x0)) != 1) stop("Function 'f' must be a univariate function of one variable.") eps <- .Machine$double.eps err <- 1; err_new <- 1 j <- 1 D <- matrix(0, nrow = maxiter, ncol = maxiter) D[1, 1] <- (f(x0+h) - f(x0-h))/(2*h) while (err > tol && j < maxiter) { h <- h / 2.0 D[j+1, 1] <- (f(x0+h) - f(x0-h)) / (2*h) for (k in 1:j) { D[j+1, k+1] <- D[j+1, k] + (D[j+1,k] - D[j,k]) / (4^k - 1) } err_new <- 2 * abs(D[j+1,j+1] - D[j,j]) / (abs(D[j+1,j+1]) + abs(D[j,j]) + eps) if (err_new >= err) break err <- err_new j <- j + 1 } if (j >= maxiter) warning("Maximum number of iterations reached.") return(list(df = D[j, j], rel.err = err, niter = j)) } numdiff <- function(f, x, maxiter = 16, h = 1/2, ..., tol = .Machine$double.eps) { if (!is.vector(x, mode = "numeric")) stop("Argument 'x' must be a numeric vector.") ndf <- function(xx) numderiv(f, xx, maxiter = maxiter, h = h, ..., tol = .Machine$double.eps)$df sapply(x, ndf) } pracma/R/abm3.R0000644000176200001440000000262711603322572012673 0ustar liggesusersabm3pc <- function(f, a, b, y0, n = 50, ...) { stopifnot(is.numeric(a), is.numeric(b)) stopifnot(is.numeric(y0), length(y0) == 1) if (!is.numeric(n) || length(n) != 1 || n < 5) stop("Argument 'n' must be an integer greater or equal to 5.") n <- floor(n) fun <- match.fun(f) f <- function(x, y) fun(x, y, ...) h <- (b-a)/n k <- h/12 x <- seq(a, b, by = h) z <- y <- numeric(n+1) z[1] <- f(a, y0) y[1] <- y0 # Use midpoint method to start k1 <- h * z[1] k2 <- h * f(a + h/2, y0 + k1/2) k3 <- h * f(a + 0.75*h, y0 + 0.75*k2) y[2] <- y0 + (2*k1 +3*k2 + 4*k3)/9 z[2] <- f(x[2], y[2]) # Use Runge-Kutta for next step k1 <- h * z[2] k2 <- h * f(x[2] + h/2, y[2] + k1/2) k3 <- h * f(x[2] + 0.75*h, y[2] + 0.75*k2) y[3] <- y[2] + (2*k1 +3*k2 + 4*k3)/9 z[3] <- f(x[2], y[2]) zz <- yy <- numeric(n) errorest <- numeric(n) # Use 3rd order A-B-M method for the remaining points # yy is the predicted, y the corrected value for (i in 3:n) { yy[i+1] <- y[i] + k * (23*z[i] - 16*z[i-1] + 5*z[i-2]) zz[i+1] <- f(x[i+1], yy[i+1]) y[i+1] <- y[i] + k * (5*zz[i+1] + 8*z[i] - z[i-1]) z[i+1] <- f(x[i+1], y[i+1]) # Error estimation errorest[i+1] <- -0.1 * (y[i+1] - yy[i+1]) } errorest <- sqrt(abs(errorest)) return(list(x = x, y = y, est.error = errorest)) } pracma/R/einsteinF.R0000644000176200001440000000111211605542363013765 0ustar liggesusers## ## e i n s t e i n F . R Einstein Functions ## einsteinF <- function(d, x) { stopifnot(is.numeric(x) || is.complex(x)) fi <- which(x == 0) if (d == 1) { y <- x^2 * exp(x) / (exp(x) - 1)^2 y[fi] <- 1 } else if (d == 2) { y <- x / (exp(x) - 1) y[fi] <- 1 } else if (d == 3) { y <- log(1 - exp(-x)) y[fi] <- -Inf } else if (d == 4) { y <- x / (exp(x) - 1) - log(1 - exp(-x)) y[fi] <- Inf } else { stop("Argument 'd' must be one of the integers 1, 2, 3, 4.") } return(y) } pracma/R/nchoosek.R0000644000176200001440000000052411540452742013657 0ustar liggesusers## ## n c h o o s e k . R Binomial Coefficients ## nchoosek <- function(n, k) { stopifnot(is.numeric(n), length(n) == 1, n >= 0, floor(n) == ceiling(n), is.numeric(k), length(k) == 1, k >= 0, floor(k) == ceiling(k)) if (k > n) stop("Argument 'k' must be an integer between 0 and 'n'.") choose(n, k) } pracma/R/laguerre.R0000644000176200001440000000167613462656464013701 0ustar liggesusers## ## l a g u e r r e . R Laguerre Method ## laguerre <- function(p, x0, nmax = 25, tol = .Machine$double.eps^(1/2)) { if (!is.numeric(p) && !is.complex(p)) stop("Argument 'p' must be a numeric or complex vector.") if ( (!is.numeric(x0) && !is.complex(x0)) || length(x0) != 1) stop("Argument 'x0' must be a real or complex number.") n <- length(p) - 1 p1 <- polyder(p) p2 <- polyder(p1) y0 <- polyval(p, x0) if (abs(y0) < tol) return(x0) for (m in 1:nmax) { a <- polyval(p1, x0) / y0 a2 <- a^2 b <- a2 - polyval(p2, x0) / y0 x <- x0 - n/(a + a/abs(a) * sqrt((n-1)*(n*b - a2))) if (is.na(x)) stop("Start value 'x0' results in an indefinite direction.") y <- polyval(p, x) if (abs(y) < tol) break x0 <- x y0 <- y } if (m > nmax) warning("Root finding process might not have converged.") return(x) } pracma/R/accumarray.R0000644000176200001440000000330711730055666014204 0ustar liggesusers## ## a c c u m a r r a y . R Accumulate Vector Elements ## uniq <- function(a, first = FALSE) { if (length(a) == 0) return(list(b = c(), m = c(), n = c())) if (!is.numeric(a) || !is.vector(a)) stop("Argument 'a' must be a numeric vector.") la <- length(a); n <- numeric(la) u <- unique(a) lu <- length(u); m <- numeric(lu) mima <- if (first) min else max for (i in 1:lu) { w <- which(a == u[i]) m[i] <- mima(w) n[w] <- i } return(list(b = u, m = m, n = n)) } accumarray <- function(subs, val, sz = NULL, func = sum, fillval = 0) { stopifnot(is.numeric(subs), is.numeric(val)) subs <- floor(subs) val <- c(val) if (any(subs < 1)) stop("Argument 'subs' must be a matrix of integer indices.") matrix_p <- TRUE if (is.vector(subs)) { subs <- as.matrix(subs) matrix_p <- FALSE } n <- nrow(subs); m <- ncol(subs) if (length(val) < n) stop("Length of 'vals' must not be smaller than no. of rows of 'subs'.") dm <- apply(subs, 2, max) if (!is.null(sz)) { if (length(sz) != ncol(subs) || any(sz < dm)) stop("Argument 'sz' does not fit with 'subs'.") dm <- sz } if (m == 1) { A <- rep(fillval, dm) for (i in unique(subs)) { A[i] <- func(val[subs == i]) } if (matrix_p) A <- as.matrix(A) } else { cm <- cumprod(dm[1:(m-1)]) A <- array(fillval, dim = dm) K <- numeric(n) for (i in 1:n) { K[i] <- subs[i, 1] + sum(cm * (subs[i, 2:m]-1)) } for (i in unique(K)) { A[i] <- func(val[K == i]) } } return(A) } pracma/R/lsqlin.R0000644000176200001440000000330112056073543013345 0ustar liggesusers## ## l s q l i n . R ## lsqlin <- function(A, b, C, d, tol = 1e-13) { stopifnot(is.numeric(A), is.numeric(b)) if (!is.matrix(A)) stop("Argument 'A' must be a numeric matrix.") n <- nrow(A); m <- ncol(A) if (is.vector(b)) { if (length(b) != n) { stop("As vector argument 'b' must have 'nrow(A)' elements.") } else { b <- as.matrix(b) l <- 1 } } else if (is.matrix(b)) { if (nrow(b) != n) { stop("As Matrix argument 'b' must also have 'nrow(A)' rows.") } else { l <- ncol(b) } } else stop("Argument 'b' must be a vector or a matrix with n rows.") if (missing(C) && missing(d)) { # x <- pinv(A) %*% b # x <- qr.solve(t(A) %*% A, t(A) %*% as.matrix(b)) x <- qr.solve(A, as.matrix(b)) return(x) } else if ( (missing(C) && !missing(d)) || (!missing(C) && missing(d))) stop("Condition 'C * x = d' not fully specified, 'C' or 'd' missing.") stopifnot(is.numeric(C), is.numeric(d)) if (!is.matrix(C) || ncol(C) != m ) stop("Argument 'C' must be a numeric matrix with 'ncol(C)=ncol(A)'.") # xc <- qr.solve(C, d) xc <- pinv(C) %*% d if ( any(abs(C %*% xc - d) > tol) ) { warning("Precondition 'C * x = d' cannot be satisfied (within tolerance 'tol').") return(c()) } N <- nullspace(C) # (m x k)-matrix, k <= p if (is.null(N)) return(c(xc)) M <- A %*% N # (n x k)-matrix #xn <- qr.solve(M, b - repmat(A %*% xc, 1, l)) xn <- pinv(M) %*% (b - repmat(A %*% xc, 1, l)) x0 <- repmat(xc, 1, l) + N %*% xn return(x0) } pracma/R/piecewise.R0000644000176200001440000000107311542750062014021 0ustar liggesusers## ## p i e c e w i s e . R Piecewise Linear Function ## piecewise <- function(x, y, abs = FALSE) { n <- length(x) areas <- 0.0 zeros <- if (y[1] == 0) c(x[1]) else c() for (i in 2:n) { if (y[i]*y[i-1] >= 0) { if (y[i] == 0) zeros <- c(zeros, x[i]) areas <- c(areas, (y[i]+y[i-1]) * (x[i]-x[i-1]) / 2.0) } else { x0 <- (x[i-1]*y[i] - x[i]*y[i-1])/(y[i] - y[i-1]) zeros <- c(zeros, x0) areas <- c(areas, y[i-1]*(x0-x[i-1])/2.0, y[i]*(x[i]-x0)/2.0) } } area <- if (abs) sum(abs(areas)) else sum(areas) return(list(area=area, zeros=zeros)) } pracma/R/eps.R0000644000176200001440000000037312201120010012606 0ustar liggesusers## ## e p s . R ## eps <- function(x = 1.0) { stopifnot(is.numeric(x)) x <- max(abs(x)) if (x < .Machine$double.xmin) { e <- .Machine$double.xmin } else { e <- 2^floor(log2(x)) * .Machine$double.eps } e } pracma/R/repmat.R0000644000176200001440000000226012062032441013323 0ustar liggesusers## ## r e p m a t . R ## repmat <- function(a, n, m = n) { if (length(a) == 0) return(c()) if (!is.numeric(a) && !is.complex(a)) stop("Argument 'a' must be a numeric or complex.") if (is.vector(a)) a <- matrix(a, nrow = 1, ncol = length(a)) if (!is.numeric(n) || !is.numeric(m) || length(n) != 1 || length(m) != 1) stop("Arguments 'n' and 'm' must be single integers.") n <- max(floor(n), 0) m <- max(floor(m), 0) if (n <= 0 || m <= 0) return(matrix(0, nrow = n, ncol = m)) matrix(1, n, m) %x% a # Kronecker product } Reshape <- function(a, n, m) { if (missing(m)) m <- length(a) %/% n if (length(a) != n*m) stop("Matrix 'a' does not have n*m elements") dim(a) <- c(n, m) return(a) } sortrows <- function(A, k = 1) { # l <- k+1 stopifnot(is.numeric(A), is.numeric(k)) if (!is.matrix(A)) stop("Argument 'A' must be a numeric matrix.") if (length(k) != 1 || floor(k) != ceiling(k)) stop("Argument 'k' must be a single integer number.") n <- nrow(A); m <- ncol(A) if (k < 1 || k > m) stop("Argument 'k' must satisfy 1 <= k <= ncol(A).") o <- order(A[, k]) A[o, ] } pracma/R/cond.R0000644000176200001440000000121411653251250012762 0ustar liggesusers## ## c o n d . R Matrix Condition ## cond <- function(M, p = 2) { if (length(M) == 0) return(0) if (!is.numeric(M)) stop("Argument 'M' must be a numeric matrix.") if (is.vector(M)) M <- matrix(c(M), nrow = length(M), ncol = 1) if (length(M) == 0) return(c()) if (ncol(M) != nrow(M) && p != 2) stop("Matrix 'M' must be square if p = 2.") if (p == 2) { s <- svd(M)$d cnd <- if (any(s == 0)) Inf else max(s) / min(s) } else { stop("At the moment, p-norms other than p = 2 are not implemented.") #cnd <- norm(M, p) * norm(inv(M), p) } return(cnd) } pracma/R/polyarea.R0000755000176200001440000000567012250325322013664 0ustar liggesusers### ### p o l y a r e a . R Calculate area and center of a polygon ### polyarea <- function(x, y) { if (length(x) == 0 && length(y) == 0) return(0) if (!(is.numeric(x) || is.complex(x)) || !(is.numeric(y) || is.complex(y))) stop("Arguments 'x' and 'y' must be real or complex.") if (is.null(dim(x))) x <- matrix(x, length(x), 1) if (is.null(dim(y))) y <- matrix(y, length(y), 1) if (any(dim(x) != dim(y))) stop("Matrices 'x' and 'y' must be of same size.") n <- nrow(x); m <- ncol(x) z <- numeric(m) for (i in 1:m) { xi <- x[, i] yi <- y[, i] # Gauss' formula p1 <- sum(xi[1:(n-1)]*yi[2:n]) + xi[n]*yi[1] p2 <- sum(xi[2:n]*yi[1:(n-1)]) + xi[1]*yi[n] z[i] <- 0.5*(p1-p2) } return(z) } poly_center <- function(x, y) { stopifnot(is.numeric(x), is.numeric(y)) n <- length(x) if (length(y) != n || n <= 2) stop("Arguments 'x' and 'y' must be of the same length >= 3.") parea <- polyarea(x, y) if (parea == 0) return(c(NA, NA)) x1 <- x[1:(n-1)]; x2 <- x[2:n] y1 <- y[1:(n-1)]; y2 <- y[2:n] xy <- x1*y2 - x2*y1 cx <- sum((x1+x2) * xy) cy <- sum((y1+y2) * xy) return(1/parea/6 * c(cx, cy)) } poly_length <- function(x, y) { stopifnot(is.numeric(x), is.numeric(y)) X <- cbind(x, y) dX <- diff(X) return(sum(sqrt(rowSums(dX^2)))) } poly_crossings <- function(L1, L2) { stopifnot(is.numeric(L1), is.numeric(L2)) # L1, L2 marices with two rows: rbind(x, y) if (!is.matrix(L1) || !is.matrix(L2) || nrow(L1) != 2 || nrow(L2) != 2) stop("Arguments 'L1', 'L2' must be matrices with 2 rows.") # Utility function Dd <- function(x, y) { x1 <- x[, 1:(ncol(x)-1)] x2 <- x[, 2:ncol(x)] y1 <- repmat(as.matrix(y), 1, ncol(x1)) y2 <- repmat(y, nrow(x2), 1) (x1 - y1) * (x2 - y1) } # Preliminary stuff x1 <- L1[1, ]; x2 <- L2[1, ] y1 <- L1[2, ]; y2 <- L2[2, ] dx1 <- diff(x1); dy1 <- diff(y1) dx2 <- diff(x2); dy2 <- diff(y2) n1 <- length(x1); n2 <- length(x2) # Determine 'signed differences' S1 <- dx1 * y1[1:(n1-1)] - dy1 * x1[1:(n1-1)] S2 <- dx2 * y2[1:(n2-1)] - dy2 * x2[1:(n2-1)] X1 <- outer(dx1, y2, "*") - outer(dy1, x2, "*") X2 <- outer(y1, dx2, "*") - outer(x1, dy2, "*") C1 <- Dd(X1, S1) C2 <- t(Dd(t(X2), S2)) # Segments with expected intersection ij <- which((C1 <= 0) & (C2 <= 0), arr.ind = TRUE) if (length(ij) == 0) return(c()) # Prepare for output i <- ij[, 1]; j <- ij[, 2] L <- dy2[j] * dx1[i] - dy1[i] * dx2[j] i <- i[L != 0]; j <- j[L != 0] L <- L[L != 0] # avoid divisions by 0 # Get the common points P <- cbind(dx2[j] * S1[i] - dx1[i] * S2[j], dy2[j] * S1[i] - dy1[i] * S2[j]) / cbind(L, L) # TO DO: throw out equal points colnames(P) <- c('x', 'y') return(P) } pracma/R/integral.R0000644000176200001440000000562113101333231013640 0ustar liggesusers## ## i n t e g r a l . R Numerical Integration ## integral <- function(fun, xmin, xmax, method = c("Kronrod", "Clenshaw","Simpson"), no_intervals = 8, random = FALSE, reltol = 1e-8, abstol = 0, ...) { stopifnot(is.numeric(xmin), length(xmin) == 1, is.numeric(xmax), length(xmax) == 1) no_intervals <- max(1, floor(no_intervals)) fun <- match.fun(fun) f <- function(x) fun(x, ...) if (length(f(xmin)) > 1 || length(f(xmax)) > 1) { stop("Function 'fun' is array-valued! Use 'quadv'.\n") } if (length(f(c(xmin, xmax))) != 2) { cat("Warning: Function 'fun' is not vectorized!\n") f = Vectorize(f) } if (xmin == xmax) return(0) method <- match.arg(method) tol <- if (abstol > 0) min(reltol, abstol) else reltol if (is.infinite(xmin) || is.infinite(xmax)) { cat("For infinite domains Gauss integration is applied!\n") Q <- quadinf(f, xmin, xmax, tol = tol)$Q return(Q) } if (random) { xs <- c(xmin, (xmax - xmin)*sort(runif(no_intervals - 1)) + xmin, xmax) } else { xs <- linspace(xmin, xmax, no_intervals + 1) } # Q <- switch(method, # "Kronrod" = quadgk(f, xmin, xmax, tol = tol), # "Clenshaw" = quadcc(f, xmin, xmax, tol = tol), # "Simpson" = simpadpt(f, xmin, xmax, tol = tol) # ) Q <- 0 if (method == "Kronrod") { for (i in 1:no_intervals) { Q = Q + quadgk(f, xs[i], xs[i+1], tol = tol) } } else if (method == "Clenshaw") { for (i in 1:no_intervals) { Q = Q + quadcc(f, xs[i], xs[i+1], tol = tol) } } else if (method == "Simpson") { for (i in 1:no_intervals) { Q = Q + simpadpt(f, xs[i], xs[i+1], tol = tol) } } else { stop("Unknown method; not available as integration routine.") } return(Q) } line_integral <- function (fun, waypoints, method = NULL, reltol = 1e-8, ...) { stopifnot(is.complex(waypoints) || is.numeric(waypoints), is.null(method) || is.character(method)) if (length(waypoints) <= 1) return(0 + 0i) fun <- match.fun(fun) f <- function(z) fun(z, ...) Q <- 0 + 0i for (i in 2:length(waypoints)) { a <- waypoints[i-1] b <- waypoints[i] d <- b - a f1 <- function(t) Re(f(a + t*d)) f2 <- function(t) Im(f(a + t*d)) if (is.null(method)) { Qre <- integrate(f1, 0, 1, subdivisions = 300L, rel.tol = reltol)$value Qim <- integrate(f2, 0, 1, subdivisions = 300L, rel.tol = reltol)$value } else { Qre <- integral(f1, 0, 1, reltol = reltol, method = method) Qim <- integral(f2, 0, 1, reltol = reltol, method = method) } Q <- Q + d * (Qre + Qim*1i) } return(Q) } pracma/R/normest.R0000644000176200001440000000165311653251250013535 0ustar liggesusers## ## n o r m e s t . R Matrix Norm estimation ## normest <- function(M, maxiter = 100, tol = .Machine$double.eps^(1/2)) { if (length(M) == 0) return(0) if (!is.numeric(M)) stop("Argument 'M' must be a numeric matrix.") if (is.vector(M)) M <- matrix(c(M), nrow = length(M), ncol = 1) x <- matrix(apply(abs(M), 2, sum), ncol = 1) est <- norm(x, "F") # Frobenius Norm if (est == 0) return(0) x <- x/est est0 <- 0 niter <- 0 while (abs(est - est0) > tol * est && niter <= maxiter) { est0 <- est Mx <- M %*% x if (all(Mx == 0)) Mx <- matrix(runif(length(Mx)), ncol(Mx), nrow(Mx)) x <- t(M) %*% Mx normx <- norm(x, "F") est <- normx / norm(Mx, "F") x <- x / normx niter <- niter + 1 } if (niter > maxiter) warning("Number of iterations exceeded 'maxiter'.") return(est) } pracma/R/polar.R0000644000176200001440000000522711700355067013170 0ustar liggesusers## ## p o l a r . R ## polar <- function(t, r, type="l", col = "blue", grcol = "darkgrey", bxcol = "black", main = "Polar Plot", add = FALSE, ...) { stopifnot(is.numeric(t), is.numeric(r)) n <- length(t) if (!is.vector(t) || !is.vector(r) || length(r) != n) stop("Arguments 't', 'r' have to be vectors of equal length.") z <- cbind(t, r) # transform coordinates xy <- pol2cart(z) if (n == 1) dim(xy) <- c(1, 2) hy <- hypot(xy[, 1], xy[, 2]) if (!add) { # grid circle coordinates drs <- pretty(c(0, hy), min.n = 3) phi <- deg2rad(seq(0, 360, by = 2)) cx <- cos(phi) cy <- sin(phi) # plot grid circles mad <- max(abs(drs)) plot(c(-mad, mad), c(-mad, mad), type = "n", asp = 1, axes = FALSE, main = main, xlab = "", ylab = "") # ann = FALSE box(col = bxcol) for (dr in drs) { lines(dr*cx, dr*cy, col=grcol, lty=3) } s1 <- 0.5 * mad; s2 <- mad * sqrt(3)/2 # grid lines lines(c(-mad, mad), c(0, 0), col=grcol, lty=3) lines(c(0, 0), c(-mad, mad), col=grcol, lty=3) lines(c(-s2, s2), c(-s1, s1), col=grcol, lty=3) lines(c(-s2, s2), c(s1, -s1), col=grcol, lty=3) lines(c(-s1, s1), c(-s2, s2), col=grcol, lty=3) lines(c(-s1, s1), c(s2, -s2), col=grcol, lty=3) # grid annotation for (dr in drs) { text(0, dr, as.character(dr), adj = c(0.5, 1), col = grcol, cex = 0.75) last <- drs[length(drs)] text(last, 0, "0", pos = 4, offset = 0.2, col = grcol, cex = 0.75, font=2) text(-last, 0, "180", pos = 2, offset = 0.2, col = grcol, cex = 0.75, font=2) text(0, last, "90", pos = 3, offset=0.2, col = grcol, cex = 0.75, font=2) text(0, -last, "270", pos = 1, offset = 0.3, col = grcol, cex = 0.75, font=2) text(s2, s1, "30", adj = c(0, 0), col = grcol, cex = 0.75) text(s1, s2, "60", adj = c(0, 0), col = grcol, cex = 0.75) text(-s1, s2, "120", adj = c(1, 0), col = grcol, cex = 0.75) text(-s2, s1, "150", adj = c(1, 0), col = grcol, cex = 0.75) text(-s2, -s1, "210", adj = c(1, 1), col = grcol, cex = 0.75) text(-s1, -s2, "240", adj = c(1, 1), col = grcol, cex = 0.75) text(s1, -s2, "300", adj = c(0, 1), col = grcol, cex = 0.75) text(s2, -s1, "330", adj = c(0, 1), col = grcol, cex = 0.75) } } # Plot the function (type can be 'l', 'p', or 'n') lines(xy[, 1], xy[, 2], type = type, col = col, ...) invisible() } pracma/R/fsolve.R0000644000176200001440000000330313452637217013350 0ustar liggesusers## ## f s o l v e . R ## fsolve <- function(f, x0, J = NULL, maxiter = 100, tol = .Machine$double.eps^(0.5), ...) { if (!is.numeric(x0)) stop("Argument 'x0' must be a numeric vector.") x0 <- c(x0) # Prepare objective function and its Jacobian fun <- match.fun(f) f <- function(x) fun(x, ...) n <- length(x0) m <- length(f(x0)) if (n == 1) stop("Function 'fsolve' not applicable for univariate root finding.") if (!is.null(J)) { Jun <- match.fun(J) J <- function(x) J(x, ...) } else { J <- function(x) jacobian(f, x) } if (m == n) { sol = broyden(f, x0, J0 = J(x0), maxiter = maxiter, tol = tol) xs <- sol$zero; fs <- f(xs) } else { sol <- gaussNewton(x0, f, Jfun = J, maxiter = maxiter, tol = tol) xs <- sol$xs; fs <- sol$fs if (fs > tol) warning("Minimum appears not to be a zero -- change starting point.") } return(list(x = xs, fval = fs)) } fzsolve <- function(fz, z0) { if (length(z0) == 0) return(c()) if (length(z0) > 1) { warning("Argument 'z0' has length > 1, first component taken.") z0 <- z0[1] } if (is.numeric(z0)) { x0 <- c(z0, 0) } else if (is.complex(z0)) { x0 <- c(Re(z0), Im(z0)) } else stop("Argument 'z0' must be a real or complex number.") fz <- match.fun(fz) fn <- function(x) { z <- x[1] + x[2]*1i Z <- fz(z) if (is.complex(Z)) Z <- c(Re(Z), Im(Z)) else if (is.numeric(Z)) Z <- c(Z, 0) else Z <- c(NA, NA) return(Z) } x <- broyden(fn, x0)$zero return(x[1] + x[2]*1i) } pracma/R/akima.R0000644000176200001440000000230212047703445013126 0ustar liggesusers## ## a k i m a . R Univariate Akima Interpolation ## akimaInterp <- function(x, y, xi) { stopifnot(is.numeric(x), is.numeric(y), is.numeric(xi), is.vector(x), is.vector(y), is.vector(xi)) n <- length(x) if (length(y) != n) stop("Vectors 'x' and 'y' must be of the same length.") dx <- diff(x) if (any(dx <= 0)) stop("Argument 'x' must be an in strictly ascending order.") if (any(xi < x[1]) || any(xi > x[n])) stop("All points in 'xi' must lie between x[1] and x[n].") m <- diff(y) / dx mm <- 2*m[1]-m[2]; mmm <- 2*mm-m[1] # augment at left mp <- 2*m[n-1]-m[n-2]; mpp <- 2*mp-m[n-1] # augment at right m1 <- c(mmm, mm, m, mp, mpp) # slopes dm <- abs(diff(m1)) f1 <- dm[3:(n+2)]; f2 <- dm[1:n]; f12 <- f1 + f2 id <- which(f12 > 1e-8 * max(f12)) b <- m1[2:n+1] b[id] <- (f1[id] * m1[id+1] + f2[id] * m1[id+2]) / f12[id] e <- (3*m - 2*b[1:n-1] - b[2:n]) / dx d <- (b[1:n-1] + b[2:n] - 2*m) / dx^2 bin <- findInterval(xi,x) bin <- pmin(bin,n-1) bb <- bin[1:length(xi)] wj <- xi - x[bb] yi <- ((wj * d[bb] + e[bb]) * wj + b[bb]) * wj + y[bb] return(yi) } pracma/R/gammainc.R0000644000176200001440000000473013643704445013633 0ustar liggesusers## ## g a m m a i n c . R Incomplete Gamma Function ## gammainc <- function(x, a) { if (!is.numeric(a) || !is.numeric(x)) stop("All arguments must be real numbers.") if (length(a) > 1 || length(x) > 1) stop("Arguments must be of length 1; function is not vectorized.") if (a < 0) stop("Argument 'a' must be real and nonnegative.") if (x == 0 && a == 0) return(c(lowinc = 0.0, uppinc = Inf, reginc = 0.0)) if (x == 0) return(c(lowinc = 0.0, uppinc = gamma(a), reginc = 0.0)) if (x > 0) xam <- -x + a*log(x) else xam <- -x + a*log(x + 0i) if (abs(xam) > 700.0 || abs(a) > 170.0) { warning("Arguments 'x' and/or 'a' are too large.") return(NA) } # Computation of the incomplete gamma function gin <- gim <- gip <- 0 if (x == 0.0) { ga <- gamma(a) gim <- ga gip <- 0.0 } else if (x <= 1.0 + a) { s <- 1/a r <- s for (k in 1:60) { r <- r * x/(a+k); s <- s+r; if (abs(r/s) < 1e-15) break } gin <- exp(xam) * s ga <- gamma(a) gip <- gin/ga gim <- ga - gin } else if (x > 1.0 + a) { t0 <- 0 for (k in 60:1) { t0 <- (k-a)/(1 + k/(x+t0)) } gim <- exp(xam)/(x+t0) ga <- gamma(a) gin <- ga - gim gip <- 1 - gim/ga } return(c(lowinc = Re(gin), uppinc = Re(gim), reginc = Re(gip))) } incgam <- function(x, a) { if (!is.numeric(a) || !is.numeric(x)) stop("All arguments must be real numbers.") if (length(a) > 1 || length(x) > 1) stop("Arguments must be of length 1; function is not vectorized.") if (x > 0) { if (a > 0) { g_gamma <- gamma(a) g_upper <- g_gamma * pgamma(x, a, 1, lower.tail = FALSE) # g_regul <- pgamma(x, a, 1, lower = TRUE) # g_lower <- g_gamma * g_regul } else if (a == 0) { g_upper <- pracma::expint_E1(x) } else if (a < 0 && a >= -1) { g_upper <- -1 * x^a*exp(-x)/a + incgam(x, a+1)/a } else { # (a < 0) stop("Not yet implemented: use recursion -- see help") } } else if (x == 0) { g_upper <- gamma(a) } else { # (x < 0) stop("Not implemented: Result for 'x<0' will be complex.") } # g_lower <- gamma(a) - g_upper # g_regul <- 1 - g_upper / gamma(a) return(g_upper) } pracma/R/subspace.R0000644000176200001440000000200314072313323013637 0ustar liggesusers## ## s u b s p a ce . R Matrix Image orth <- function(M) { if (length(M) == 0) return(c()) if (!is.numeric(M)) stop("Argument 'M' must be a numeric matrix.") if (is.vector(M)) M <- matrix(c(M), nrow = length(M), ncol = 1) svdM <- svd(M) U <- svdM$u s <- svdM$d tol <- max(dim(M)) * max(s) * .Machine$double.eps r <- sum(s > tol) U[,1:r, drop = FALSE] } subspace <- function(A, B) { if (!is.numeric(A) || !is.numeric(B)) stop("Arguments 'A' and 'B' must be numeric matrices.") if (is.vector(A)) A <- matrix(c(A), nrow = length(A), ncol = 1) if (is.vector(B)) B <- matrix(c(B), nrow = length(B), ncol = 1) if (nrow(A) != nrow(B)) stop("Matrices 'A' and 'B' must have the same number of rows.") A <- orth(A) B <- orth(B) if (ncol(A) < ncol(B)) { tmp <- A; A <- B; B <- tmp } for (k in 1:ncol(A)) { B <- B - A[, k] %*% t(A[, k]) %*% B } asin(min(1, max(svd(B)$d))) } pracma/R/size.R0000644000176200001440000000171013630250433013011 0ustar liggesusers## ## s i z e . R Matlab size, numel, ndims, and isempty functions ## size <- function(x, k) { if (length(x) == 0) sz <- 0 else if (is.vector(x)) sz <- c(1, length(x)) else if (is.array(x)) sz <- dim(x) else sz <- NULL if (!missing(k)) { if (k > length(sz)) sz <- 1 else if (k >= 1) sz <- sz[k] else stop("Requested dimension 'k' is out of range.") } return(sz) } numel <- function(x) { sz <- size(x) if (!is.null(sz)) prod(sz) else return(NULL) } nnz <- function(x) { if (length(x) == 0) return(0) stopifnot(is.numeric(x) || is.complex(x)) sum(x != 0) } ndims <- function(x) { if (length(x) == 0) nd <- 0 else if (is.vector(x)) nd <- 1 else if (is.array(x)) nd <- length(dim(x)) else nd <- NA return(nd) } # ndims <- function(x) { # sz <- size(x) # if (!is.null(sz)) length(sz) # else return(NULL) # } isempty <- function(x) { length(x) == 0 }pracma/R/eig.R0000755000176200001440000000061011540452742012611 0ustar liggesusers### ### EIG.R Eigenvalues ### eig <- function(a) { if (length(a) == 0) return(matrix(0, nrow=0, ncol=0)) if (length(a) == 1) return(a) if ((!is.numeric(a) && !is.complex(a)) || !is.matrix(a)) stop("Argument 'a' must be a numeric or complex matrix.") if (nrow(a) != ncol(a)) stop("Matrix 'a' must be square matrix.") eigen(a, only.values=TRUE)$values } pracma/R/deg2rad.R0000644000176200001440000000034211665436767013375 0ustar liggesusers## ## d e g 2 r a d . R Angle Conversion ## deg2rad <- function(deg) { stopifnot(is.numeric(deg)) ( rad <- (pi/180)*deg ) } rad2deg <- function(rad) { stopifnot(is.numeric(rad)) ( deg <- rad/(pi/180) ) } pracma/R/bisect.R0000644000176200001440000000620113342034603013307 0ustar liggesusers## ## b i s e c t . R ## bisect <- function(fun, a, b, maxiter = 500, tol = NA, ...) # Bisection search, trimmed for exactness, not number of iterations { fun <- match.fun(fun) f <- function(x) fun(x, ...) if (!is.na(tol)) warning("Deprecated: Argument 'tol' not used anymore.") if (f(a)*f(b) > 0) stop("f(a) and f(b) must have different signs.") x1 <- min(a, b); x2 <- max(a,b) xm <- (x1+x2)/2.0 n <- 1 while (x1 < xm && xm < x2 && n < maxiter) { n <- n+1 if (sign(x1) != sign(x2) && x1 != 0 && x2 != 0) { xm <- 0.0 if (f(xm) == 0.0) {x1 <- x2 <- xm; break} } if (sign(f(x1)) != sign(f(xm))) { x2 <- xm } else { x1 <- xm } xm <- (x1 + x2) / 2.0 } return(list(root=xm, f.root=f(xm), iter=n, estim.prec=abs(x1-x2))) } secant <- function(fun, a, b, maxiter = 500, tol = 1e-08, ...) # Secant search for zero of a univariate function { fun <- match.fun(fun) f <- function(x) fun(x, ...) x1 <- a; x2 <- b f1 <- f(x1); if (abs(f1) <= tol) return(x1) f2 <- f(x2); if (abs(f2) <= tol) return(x1) n <- 0 while (n <= maxiter && abs(x2 - x1) > tol) { n <- n+1 slope <- (f2 - f1)/(x2 - x1) if (slope == 0) return(root=NA, f.root=NA, iter=n, estim.prec=NA) x3 <- x2 - f2/slope f3 <- f(x3); if (abs(f3) <= tol) break x1 <- x2; f1 <- f2 x2 <- x3; f2 <- f3 } if (n > maxiter) { warning("Maximum number of iterations 'maxiter' was reached.") } return(list(root=x3, f.root=f3, iter=n, estim.prec=2*abs(x3-x2))) } regulaFalsi <- function(fun, a, b, maxiter = 500, tol = 1e-08, ...) #Regula Falsi search for zero of a univariate function in a bounded interval { fun <- match.fun(fun) f <- function(x) fun(x, ...) x1 <- a; x2 <- b f1 <- f(x1); f2 <- f(x2) if (f1*f2 > 0) stop("f(a) and f(b) must have different signs.") m <- 0.5 # Illinois rule niter <- 0 while (abs(x2-x1) >= tol && niter <= maxiter) { niter <- niter + 1 x3 <- (x1*f2-x2*f1)/(f2-f1); f3 <- f(x3) if(f3*f2 < 0) { x1 <- x2; f1 <- f2 x2 <- x3; f2 <- f3 } else { # m <- f2/(f2+f3) # Pegasus rule # m <- if (1-f3/f2 > 0) 1-f3/f2 else 0.5 # Andersen/Bjoerk f1 <- m * f1 x2 <- x3; f2 <- f3 } } if (niter > maxiter && abs(x2-x1) >= tol) cat("regulaFalsi stopped without converging.\n") return(list(root = x3, f.root = f3, niter = niter, estim.prec = x1-x2)) } # bisect <- function(f, a, b, maxiter=100, tol=.Machine$double.eps^0.5) # # Bisection search for zero of a univariate function in a bounded interval # { # if (f(a)*f(b) > 0) stop("f(a) and f(b) must have different signs.") # x1 <- min(a, b); x2 <- max(a,b) # xm <- (x1+x2)/2.0 # n <- 0 # while (abs(x1-x2)/2.0 > tol) { # n <- n+1 # if (abs(f(xm)) <= tol) break # if (f(x1)*f(xm) < 0) { # x2 <- xm # } else { # x1 <- xm # } # xm <- (x1+x2)/2.0 # xm <- x1 - f(x1) * (x2-x1) / (f(x2)-f(x1)) # if (n >= maxiter) break # } # return(list(root=xm, f.root=f(xm), iter=n, estim.prec=abs(x1-x2)/2.0)) # } pracma/R/qr.R0000644000176200001440000000540312030661377012472 0ustar liggesusers## ## q r . R QR Factorization ## # Modified Gram-Schmidt process gramSchmidt <- function(A, tol = .Machine$double.eps^0.5) { stopifnot(is.numeric(A), is.matrix(A)) m <- nrow(A); n <- ncol(A) if (m < n) stop("No. of rows of 'A' must be greater or equal no. of colums.") Q <- matrix(0, m, n) R <- matrix(0, n, n) for (k in 1:n) { Q[, k] <- A[, k] if (k > 1) { for (i in 1:(k-1)) { R[i, k] <- t(Q[, i]) %*% Q[, k] Q[ , k] <- Q[, k] - R[i, k] * Q[, i] } } R[k, k] <- Norm(Q[, k]) if (abs(R[k, k]) <= tol) stop("Matrix 'A' does not have full rank.") Q[, k] <- Q[, k] / R[k, k] } return(list(Q = Q, R = R)) } qrSolve <- function(A, b) { stopifnot(is.numeric(A), is.matrix(A), is.numeric(b)) m <- nrow(A); n <- ncol(A) b <- c(b) if (m < n || length(b) != m) stop("Matrix 'A' and vektor 'b' have non-fitting dimensions.") gs <- householder(A) Q <- gs$Q; R <- gs$R b <- t(Q[, 1:n]) %*% b x <- numeric(n) x[n] <- b[n] / R[n, n] for (k in (n-1):1) x[k] <- (b[k] - R[k, (k+1):n] %*% x[(k+1):n]) / R[k, k] return(x) } # Givens transformation .givens <- function(xk, xl) { if (xl != 0) { r <- Norm(c(xk, xl)) G <- matrix(c(xk, -xl, xl, xk), 2, 2) / r x <- as.matrix(c(r, 0)) } else { G <- eye(2) x <- as.matrix(c(xk, 0)) } return(list(G = G, x = x)) } # Givens QR decomposition givens <- function(A) { # n >= m stopifnot(is.numeric(A), is.matrix(A)) n <- nrow(A); m <- ncol(A) if (n != m) stop("Matrix 'A' must be a square matrix.") Q <- eye(n) for (k in 1:(n-1)) { l <- which.max(abs(A[(k+1):n, k])) + k if (A[k, k] == 0 && A[l, k] == 0) stop("Matrix 'A' does not have full rank.") j <- which(A[(k+1):n, k] != 0) + k j <- unique(c(l, j[j != 1])) for (h in j) { gv <- .givens(A[k, k], A[h, k]) G <- gv$G; x <- gv$x Q[c(k, h), ] <- G %*% Q[c(k, h), ] A[k, k] <- x[1] A[h, k] <- 0 A[c(k, h), (k+1):m] <- G %*% A[c(k, h), (k+1):m] } } return(list(Q = t(Q), R = triu(A))) } # Householder transformation householder <- function(A) { m <- nrow(A); n <- ncol(A) Q <- eye(m) for (k in 1:min(m-1, n)) { ak <- A[k:m, k, drop = FALSE] s <- if (ak[1] >= 0) 1 else -1 vk <- ak + s * Norm(ak) * c(1, rep(0, m-k)) vk2 <- c(t(vk) %*% vk) Hk <- eye(m-k+1) - 2/vk2 * (vk %*% t(vk)) if (k == 1) Qk <- Hk else Qk <- blkdiag(eye(k-1), Hk) A <- Qk %*% A Q <- Q %*% Qk } return(list(Q = Q, R = A)) } pracma/R/plotyy.R0000644000176200001440000000250211726441722013406 0ustar liggesusers## ## p l o t y y . R Two-ordinates Plot ## plotyy <- function( x1, y1, x2, y2, gridp = TRUE, box.col = "grey", type = "l", lwd = 1, lty = 1, xlab = "x", ylab = "y", main = "", col.y1 = "navy", col.y2 = "maroon", ...) { stopifnot(is.numeric(x1), is.numeric(y1), is.numeric(x2), is.numeric(y2)) y1pretty <- pretty(y1); y1l <- min(y1pretty); y1u <- max(y1pretty) y2pretty <- pretty(y2); y2l <- min(y2pretty); y2u <- max(y2pretty) ptrans <- function(y) y1l + (y - y2l)/(y2u - y2l) * (y1u - y1l) y1pretty <- pretty(c(y1, ptrans(y2))) opar <- par(mar = c(4.1, 4.1, 3.1, 3.1)) plot(range(c(x1, x2)), range(y1pretty), xlab = xlab, ylab = ylab, main = main, type = "n", yaxt = "n", bty = "n", ...) box(col = box.col) mx <- axis(side = 2, at = y1pretty, labels = FALSE, col = col.y1) my <- axis(side = 4, at = ptrans(y2pretty), labels = FALSE, col = col.y2) mtext(mx, side = 2, line = 1, at = mx, col = col.y1) mtext(y2pretty, side = 4, line = 1, at = my, col = col.y2) if (gridp) grid() points(x1, y1, type = type, col = col.y1, lwd = lwd, lty = lty) points(x2, ptrans(y2), type = type, col = col.y2, lwd = lwd, lty = lty) par(opar) invisible() } pracma/R/andrews.R0000644000176200001440000000306511667447255013531 0ustar liggesusers## ## a n d r e w s . R Andrews Curves ## andrewsplot <- function(A, f, style = "pol", scaled = FALSE, npts = 101) { stopifnot(is.numeric(A), is.matrix(A)) if (is.factor(f)) f <- as.integer(f) if (!is.integer(f)) stop("Argument 'f' must be a factor or an integer vector.") n <- nrow(A); m <- ncol(A) if (m < 2 || n < 2) stop("Matrix 'A' must have at least two rows and columns.") if (scaled) A <- scaled(A) xpts <- seq(0, 2*pi, length = npts) Y <- matrix(NA, nrow = n, ncol = npts) # Compute the Andrews function for (i in 1:n) { xs <- A[i, ] ypts <- c() for (p in xpts) { y <- xs[1] for (j in 2:m) { if (j %% 2 == 1) { y <- y + xs[j]*sin((j %/% 2)*p) } else { y <- y + xs[j]*cos((j %/% 2)*p) } } ypts <- c(ypts, y) } Y[i, ] <- ypts } if (style == "cart") { # plot in cartesian coordinates ymin <- min(Y) ymax <- max(Y) plot(0, 0, type="n", xlim=c(0, 2*pi), ylim=c(ymin, ymax), main="Andrews' Curves", xlab="", ylab="") for (i in sample(1:n, n)) { lines(xpts, Y[i, ], col = f[i]) } } else if (style == "pol") { ymax <- max(abs(Y)) polar(0, ymax, type="n", main = "Andrews' Curves", bxcol = "white") for (i in sample(1:n, n)) { polar(xpts, Y[i, ], col=f[i], add=TRUE) } } else stop("Argument 'style' can only be 'cart' or 'pol'.") invisible() } pracma/R/rectint.R0000644000176200001440000000230212210406370013501 0ustar liggesusers## ## r e c t i n t . R Rectangular Intersections ## rectint <- function(x, y) { stopifnot(is.numeric(x), is.numeric(y)) if (is.vector(x) && length(x) == 4 && is.vector(y) && length(y) == 4) { if (any(c(x[3], x[4], y[3], y[4]) < 0)) stop("All widths and heights must be greater than 0.") if (x[1]+x[3] <= y[1] || y[1]+y[3] <= x[1] || x[2]+x[4] <= y[2] || y[2]+y[4] <= x[2]) { return(0) } else { if (x[1] > y[1]) { tmp <- x; x <- y; y <- tmp } z1 <- y[1] z2 <- max(x[2], y[2]) z3 <- min(x[1]+x[3], y[1]+y[3]) z4 <- min(x[2]+x[4], y[2]+y[4]) area <- (z3-z1) * (z4-z2) return(area) } } else if (is.matrix(x) && ncol(x) == 4 && is.matrix(y) && ncol(y) == 4) { nx <- nrow(x); ny <- nrow(y) R <- matrix(NA, nrow = nx, ncol = ny) for (i in 1:nx) { for (j in 1:ny) { R[i, j] <- rectint(x[i, ], y[j, ]) } } return(R) } else { stop("All lengths and no. of matrix columns must be equal to 4.") } } pracma/R/bvp.R0000644000176200001440000000333312722564044012640 0ustar liggesusers## ## b v p . R Boundary Value Problems ## bvp <- function(f, g, h, x, y, n = 50) { stopifnot(is.numeric(x), is.numeric(y), is.numeric(n)) if (length(x) != 2 || length(y) != 2) stop("Arguments 'x' and 'y' must have length 2.") if (length(n) != 1 || floor(n) != ceiling(n) || n < 2) stop("Argument 'n' must be an integer greater or equal 2.") if (is.numeric(f)) ffun <- function(x) rep(f[1], length(x)) else ffun <- match.fun(f) if (is.numeric(g)) gfun <- function(x) rep(g[1], length(x)) else gfun <- match.fun(g) if (is.numeric(h)) hfun <- function(x) rep(h[1], length(x)) else hfun <- match.fun(h) xa <- x[1]; xb <- x[2] ya <- y[1]; yb <- y[2] xs <- linspace(xa, xb, n+2)[2:(n+1)] dt <- (xb - xa) / (n+1) a <- -2 - dt^2 * gfun(xs) # main diagonal b <- 1 - dt/2 * ffun(xs[1:(n-1)]) # superdiagonal d <- 1 + dt/2 * ffun(xs[2:n]) # subdiagonal rhs <- dt^2 * hfun(xs) # right hand side rhs[1] <- rhs[1] - ya * (1 + (dt/2) * ffun(xs[1])) rhs[n] <- rhs[n] - yb * (1 - (dt/2) * ffun(xs[n])) ys <- trisolve(a, b, d, rhs) return(list(xs = c(xa, xs, xb), ys = c(ya, ys, yb))) } # bvp <- function(p, q, r, a, b, ya, yb) { # z0 <- as.matrix(c(ya, 0, 0, 1)) # fun0 <- function(x, z) { # as.matrix(c(z[2], # p(x)*z[2] + q(x)*z[1] + r(x), # z[4], # p(x)*z[4] + q(x)*z[3] # ) # ) # } # res <- ode45(fun0, a, b, z0, hmax = 0.05) # t <- res$t; z <- res$y # n <- length(t) # # y <- z[, 1] + (yb - z[n, 1]) * z[, 3] / z[n, 3] # return(list(xs = t, ys = y)) # } pracma/R/cotes.R0000644000176200001440000000351011604605476013166 0ustar liggesusers## ## n e w t o n _ c o t e s . R Newton-Cotes Formulas ## cotes <- function(f, a, b, n = 20, nodes = 5, ...) { if (nodes < 2 || nodes > 8) stop("Number of nodes, 'nodes', must be between 2 and 8.") if (n < nodes) stop("Argument 'n' must be greater or equal to the number of nodes.") fun <- match.fun(f) f <- function(x) fun(x, ...) N <- (nodes-1) * ceiling(n/(nodes-1)) N1 <- N+1 x<- linspace(a,b,N1) h <- x[2] - x[1] g <- f(x) if (length(g) != N1) { g <- numeric(N1) for (i in 1:N1) g[i] <- f(x[i]) } endpts <- g[1] + g[N1] switch(nodes - 1, # (2) Trapezoidal rule Q <- (h/2) * (endpts + 2*sum(g[2:N])), # (3) Simpson-Kepler rule Q <- (h/3) * (endpts + 4*sum(g[seq(2,N,2)]) + 2*sum(g[seq(3,N,2)])), # (4) Simpson's 3/8 rule Q <- (3*h/8) * (endpts + 3*sum(g[seq(2,N,3)] + g[seq(3,N,3)]) + 2*sum(g[seq(4,N,3)])), # (5) Boole's 4/90 rule Q <- (4*h/90) * (7*endpts + 32*sum(g[seq(2,N,4)]) + 12*sum(g[seq(3,N,4)]) + 32*sum(g[seq(4,N,4)]) + 14*sum(g[seq(5,N,4)])), # (6) Five-point rule Q <- (5*h/288) * (19*endpts + 75*sum(g[seq(2,N,5)] + g[seq(5,N,5)]) + 50*sum(g[seq(3,N,5)] + g[seq(4,N,5)]) + 38*sum(g[seq(6,N,5)])), # (7) Weddle rule Q <- (6*h/840) * (41*endpts + 216*sum(g[seq(2,N,6)] + g[seq(6,N,6)]) + 27*sum(g[seq(3,N,6)] + g[seq(5,N,6)]) + 272*sum(g[seq(4,N,6)]) + 82*sum(g[seq(7,N,6)])), # (8) (no name) Q <- (7*h/17280) * (751*endpts + 3577*sum(g[seq(2,N,7)] + g[seq(7,N,7)]) + 1323*sum(g[seq(3,N,7)] + g[seq(6,N,7)]) + 2989*sum(g[seq(4,N,7)] + g[seq(5,N,7)]) + 1502*sum(g[seq(8,N,7)])) ) return(Q) } pracma/R/triquad.R0000644000176200001440000000416212001517521013507 0ustar liggesusers## ## t r i q u a d . R Gaussian Triangle Quadrature ## triquad <- function(f, x, y, n = 10, tol = 1e-10, ...) { if (!is.numeric(x) || length(x) != 3 || !is.numeric(y) || length(y) != 3) stop("Arguments 'x' and 'y' must be numeric vectors of length 3.") n <- floor(abs(n)) if (n <= 2) stop("Argument 'n' must be an integer greater or equal 2.") fun <- match.fun(f) f <- function(x, y) fun(x, y, ...) v <- cbind(x, y) rel.tol <- Inf kmax <- 5 k <- 1 while (rel.tol > tol && k <= kmax) { G1 <- .tricoef(v, N = n) I1 <- t(G1$Wx) %*% f(G1$X, G1$Y) %*% G1$Wy G2 <- .tricoef(v, N = 2*n+1) I2 <- t(G2$Wx) %*% f(G2$X, G2$Y) %*% G2$Wy rel.tol <- abs(I1 - I2) k <- k + 1 } return(c(I2)) } .tricoef <- function(v, N = 32, ...) { eps <- .Machine$double.eps n <- 1:N nnk <- 2*n + 1 A <- c(1/3, repmat(1,1,N) / (nnk * (nnk+2))) n <- 2:N nnk <- nnk[n] B1 <- 2/9 nk <- n+1 nnk2 <- nnk * nnk B <- 4*(n * nk)^2 / (nnk2 * nnk2 - nnk2) ab <- cbind(A, c(2, B1, B)) s <- sqrt(ab[2:N, 2]) VX <- eigen(Diag(ab[1:N,1], 0) + Diag(s, -1) + Diag(s, 1)) X <- VX$values V <- VX$vectors I <- order(X) X <- X[I] x <- (X + 1) / 2 wx <- ab[1,2] * as.matrix(V[1,I])^2 / 4 N <- N-1; N1 <- N+1; N2 <- N+2 y <- cos((2*as.matrix(N:0)+1)*pi/(2*N+2)) L <- zeros(N1, N2) y0=2 iter=0; while (max(abs(y-y0)) > eps) { L[, 1] <- 1 L[, 2] <- y for (k in 2:N1) { L[, k+1] <- ( (2*k-1) * y * L[, k] - (k-1) * L[,k-1] ) / k } Lp <- N2 * ( L[, N1] - y * L[,N2] ) / (1-y^2) y0 <- y y <- y0 - L[, N2]/Lp iter <- iter+1 } cc <- matrix(c(1,0,0, -1,0,1, 0,1,-1), 3, 3, byrow = TRUE) %*% v t1 <- (1+y)/2 Wx <- abs(det(cc[2:3,])) * wx Wy <- 1/((1-y^2) * Lp^2) * (N2/N1)^2 mg <- meshgrid(t1, x) t2 <- mg$X; xx <- mg$Y yy <- t2 * xx X <- cc[1,1] + cc[2,1]*xx + cc[3,1]*yy Y <- cc[1,2] + cc[2,2]*xx + cc[3,2]*yy return(list(X = X, Y = Y, Wx = Wx, Wy = Wy)) } pracma/R/cranknic.R0000644000176200001440000000215111654745276013651 0ustar liggesusers## ## c r a n k n i c . R Crank-Nicolson ## cranknic <- function(f, t0, t1, y0, ..., N = 100) { stopifnot(is.numeric(y0), is.numeric(t0), length(t0) == 1, is.numeric(t1), length(t1) == 1) if (is.vector(y0)) { y0 <- as.matrix(y0) } else if (is.matrix(y0)) { if (ncol(y0) != 1) stop("Argument 'y0' must be a row or column vector.") } fun <- match.fun(f) f <- function(t, y) fun(t, y, ...) n <- length(y0) y <- y0 yout <- matrix(NA, N, n) yout[1, ] <- c(y0) h <- (t1 - t0)/(N-1) t <- 0 ts <- linspace(t0, t1, N) # internal function used for root finding cnfun <- function(w) w - y - 0.5* h * (f(t, w) + f(t, y)) m <- length(f(t0, y0)) if (m != n) stop("Function f must return a vector the same length as 'y0'.") # solver used for root finding if (n == 1) solver <- fzero else solver <- fsolve for (i in 2:N) { t <- ts[i] w <- solver(cnfun, y)$x yout[i, ] <- w y <- w } if (n == 1) yout <- drop(yout) return(list(t = ts, y = yout)) } pracma/R/sumalt.R0000644000176200001440000000050212465177436013362 0ustar liggesusers## ## s u m a l t . R Summing alternating series ## sumalt <- function(f_alt, n) { b <- 2^(2*n-1) c <- b # ; s <- 0 s <- 0.0 for (k in (n-1):0) { t <- f_alt(k) s <- s + c*t b <- b * (2*k+1) * (k+1) / (2 * (n-k) * (n+k)) c <- c + b } s <- s / c return(s) } pracma/R/pascal.R0000644000176200001440000000127511540452742013315 0ustar liggesusers## ## p a s c a l . R Pascal Triangle ## pascal <- function(n, k=0) { # Tests: P0 == P1 %*% t(P1); P2 %^% 3 == eye stopifnot(is.numeric(n), length(n) == 1, is.numeric(k), length(k) == 1) if (!(k %in% c(0, 1, 2))) stop("Argument 'k' must be 0, 1 or 2.") if (floor(n) != ceiling(n)) n <- floor(n) if (n <= 0) return(c()) if (n == 1) return(c(1)) p <- matrix(0, nrow=n, ncol=n) p[1, ] <- rep(1, n) for (i in 2:n) { p[i, ] <- cumsum(p[i-1, ]) } if (k == 0) return(p) # k == 1: p1 <- matrix(0, nrow=n, ncol=n) for (j in 1:n) { p1[j, 1:j] <- diag(p[1:j, j:1]) * (-1)^(0:(j-1)) } if (k == 2) { p1 <- rot90(p1, -1) if (n %% 2 == 0) p1 <- -p1 } return(p1) } pracma/R/ratinterp.R0000644000176200001440000000334111602373500014047 0ustar liggesusersratinterp <- function(x, y, xs = x) { if (!is.vector(x, mode="numeric") || !is.vector(y, mode="numeric")) stop("Arguments 'x' and 'y' must be numeric vectors.") m <- length(x) if (length(y) != m) stop("Arguments 'x' and 'y' must be vectors of the same length.") if (m <= 2) stop("Arguments 'x', 'y' must have at least a length >= 3.") if (is.unsorted(x)) stop("Argument 'x' must be a sorted vector") n <- length(xs) ys <- numeric(n) node_p <- FALSE for (h in 1:n) { for (i in 1:m) { d <- xs[h] - x[i] # First stage: xs[h] is data points if (d == 0) { ys[h] <- y[i] node_p <- TRUE } } if (!node_p) { # Second stage R <- matrix(0, nrow = m, ncol = m) R[, 1] <- y for (i in 1:(m-1)) { D <- R[i+1, 1] - R[i, 1] rr <- (xs[h] - x[i]) / (xs[h] - x[i+1]) denom <- rr * (1 - D/R[i+1, 1]) - 1 R[i, 2] <- R[i+1, 1] + D/denom } for (j in 3:m) { # Third and next stages for (i in 1:(m-j+1)) { D <- R[i+1, j-1] - R[i, j-1] rr <- (xs[h] - x[i]) / (xs[h]- x[i+j-1]) if (D == 0) { R[i, j] <- R[i+1, j-1] } else { DD <- R[i+1, j-1] - R[i+1, j-2] denom <- rr * (DD - D) - DD R[i, j] <- R[i+1, j-1] + D * DD / denom } } } ys[h] <- R[1, m] } node_p <- FALSE } return(ys) } pracma/R/magic.R0000644000176200001440000000361112001565513013120 0ustar liggesusers### ### m a g i c . R -- Create a Magic Square ### magic <- function(n) { if (!is.numeric(n)) { stop("Argument 'n' must be numeric.") } else if (!(length(n) == 1)) { stop("Argument 'n' must be of length 1.") } oddOrder <- function(n) { J <- matrix(rep(1:n, each = n), n, n) I <- matrix(rep(1:n, times = n), n, n) A <- (I + J - (n + 3) / 2) %% n B <- (I + 2 * J - 2) %% n M <- n * A + B + 1; return(M) } doublyEvenOrder <- function(n) { J <- matrix(rep(1:n, each = n), n, n) I <- matrix(rep(1:n, times = n), n, n) K <- trunc((I %% 4) / 2) == trunc((J %% 4) / 2) M <- t(matrix(1:(n*n), n, n)) # M <- t(pracma::Reshape(as.matrix(1:(n * n)), n, n)) M[K] = n * n + 1 - M[K] return(M) } singlyEvenOrder <- function(n) { p <- n / 2 M <- magic(p) M <- rbind(cbind(M, M + 2 * p ^ 2), cbind(M + 3 * p ^ 2, M + p ^ 2)) if (!(n == 2)) { i <- t(1:p) k <- (n - 2) / 4 j <- c(1:k, if ((n - k + 2) <= n) (n - k + 2):n) M[cbind(i, i + p), j] <- M[cbind(i + p, i), j] i <- k + 1 j <- c(1, i) M[cbind(i, i + p), j] <- M[cbind(i + p, i), j] } return(M) } n <- floor(n) M <- if (n <= 0) { matrix(numeric(0), 0, 0) # degenerate } else if (n == 1) { matrix(as.numeric(1), 1, 1) # degenerate } else { if (pracma::mod(n, 2) == 1) { oddOrder(n) } else if (pracma::mod(n, 4) == 0) { doublyEvenOrder(n) } else { singlyEvenOrder(n) } } if (n == 2) # impossible warning("There is no magic square of order 2.") return(M) } pracma/R/fminbnd.R0000644000176200001440000001367512431645662013503 0ustar liggesusers## ## f m i n b n d . R Brent's Minimization Algorithm ## fminbnd <- function(f, a, b, maxiter = 1000, maximum = FALSE, tol = 1e-07, rel.tol = tol, abs.tol = 1e-15, ...) { stopifnot(is.numeric(a), length(a) == 1, is.numeric(b), length(b) == 1) if (a >= b) stop("Interval end points must fulfill a < b !") fun <- match.fun(f) if (maximum) f <- function(x) -fun(x, ...) else f <- function(x) fun(x, ...) # phi is the square of the inverse of the golden ratio. phi <- 0.5 * ( 3.0 - sqrt ( 5.0 ) ) xl <- a; xu <- b xmin <- xl + phi*(xu-xl) fmin <- f(xmin) nfeval <- 1 step <- step2 <- 0.0 xmin1 <- xmin; fmin1 <- fmin xmin2 <- xmin; fmin2 <- fmin converged <- FALSE iter <- 0 while (iter < maxiter) { pp <- qq <- 0.0 tolx <- rel.tol * abs(xmin) + abs.tol xm = (xu+xl)/2 if (abs(xmin - xm) <= 2*tolx - (xu-xl)/2) { converged <- TRUE break } iter <- iter + 1 if (abs(step2) > tolx) { rr <- (xmin - xmin1) * (fmin - fmin2) qq <- (xmin - xmin2) * (fmin - fmin1) pp <- (xmin - xmin2) * qq - (xmin - xmin1) * rr qq <- 2*(qq - rr) if (qq > 0) { pp <- -pp } else { qq <- -qq } } if (abs(pp) < abs(qq*step2/2) && pp < qq*(xu-xmin) && pp < qq*(xmin-xl)) { step2 <- step step <- pp/qq xtemp <- xmin + step if ((xtemp - xl) < 2*tolx || (xu - xtemp) < 2*tolx) { step <- if (xmin < xm) tolx else -tolx } } else { step2 <- if (xmin < xm) xu - xmin else xl - xmin step <- phi * step2 } if (abs(step) >= tolx) { xnew <- xmin + step } else { xnew <- xmin + (if (step > 0) tolx else -tolx) } fnew <- f(xnew) nfeval <- nfeval + 1 if (fnew <= fmin) { if (xnew < xmin) { xu <- xmin } else { xl <- xmin } xmin2 <- xmin1; fmin2 <- fmin1 xmin1 <- xmin; fmin1 <- fmin xmin <- xnew; fmin <- fnew } else { if (xnew < xmin) { xl <- xnew } else { xu <- xnew } if (xnew <= xmin1 || xmin1 == xmin) { xmin2 = xmin1; fmin2 = fmin1 xmin1 = xnew; fmin1 = fnew } else if (xnew <= xmin2 || xmin2 == xmin || xmin2 == xmin1) { xmin2 <- xnew; fmin2 <- fnew } } } return(list(xmin = xmin, fmin = fmin, niter = iter, estim.prec = abs(step))) } # fminbnd <- function(f, a, b, ..., maxiter = 1000, maximum = FALSE, # tol = .Machine$double.eps^(2/3)) { # stopifnot(is.numeric(a), length(a) == 1, # is.numeric(b), length(b) == 1) # if (a >= b) # stop("Interval end points must fulfill a < b !") # # fun <- match.fun(f) # if (maximum) # f <- function(x) -fun(x, ...) # else # f <- function(x) fun(x, ...) # # # phi is the square of the inverse of the golden ratio. # phi <- 0.5 * ( 3.0 - sqrt ( 5.0 ) ) # # # Set tolerances # tol1 <- 1 + eps() # eps0 <- sqrt(eps()) # tol3 <- tol / 3 # # sa <- a; sb <- b # x <- sa + phi * ( b - a ) # fx <- f(x) # v <- w <- x # fv <- fw <- fx # e <- 0.0; # # niter <- 1 # while ( niter <= maxiter ) { # xm <- 0.5 * ( sa + sb ) # t1 <- eps0 * abs ( x ) + tol/3 # t2 <- 2.0 * t1 # # # Check the stopping criterion. # if ( abs ( x - xm ) <= t2 - (dx <- ( sb - sa ) / 2 ) ) break # # r <- 0.0 # p <- q <- r # # # Fit a parabola. # if ( t1 < abs ( e ) ) { # r <- ( x - w ) * ( fx - fv ) # q <- ( x - v ) * ( fx - fw ) # p <- ( x - v ) * q - ( x - w ) * r # q <- 2.0 * ( q - r ); # # if ( 0.0 < q ) p <- - p # # q <- abs ( q ) # r <- e # e <- d # } # # # Is the parabola acceptable # if ( abs ( p ) < abs ( 0.5 * q * r ) && # q * ( sa - x ) < p && # p < q * ( sb - x ) ) { # # Take the parabolic interpolation step. # d <- p / q # u <- x + d # # # F must not be evaluated too close to a or b. # if ( ( u - sa ) < t2 | ( sb - u ) < t2 ) { # d <- if (x < xm) t1 else -t1 # } # # } else { # # A golden-section step. # e <- if (x < xm) sb - x else a - x # d <- phi * e # } # # # F must not be evaluated too close to X. # if ( t1 <= abs ( d ) ) { # u = x + d # } else if ( 0.0 < d ) { # u = x + t1 # } else { # u = x - t1 # } # # fu = f ( u ) # # # Update a, b, v, x, and x. # if ( fu <= fx ) { # if ( u < x ) sb <- x # else sa <- x # # v <- w; fv <- fw # w <- x; fw <- fx # x <- u; fx <- fu # # } else { # if ( u < x ) sa <- u # else sb <- u # # if ( fu <= fw || w == x ) { # v <- w; fv <- fw # w <- u; fw <- fu # } else if ( fu <= fv || v == x || v== w ) { # v <- u; fv <- fu # } # } # niter <- niter + 1 # # } #endwhile # # if (niter > maxiter) # warning("No. of max. iterations exceeded; no convergence reached.") # # if (maximum) fx <- -fx # return( list(xmin = x, fmin = fx, niter = niter, estim.prec = dx) ) # } pracma/R/primes.R0000755000176200001440000000067712030256324013352 0ustar liggesusers### ### p r i m e s . R Prime numbers ### primes <- function(n) { if (!is.numeric(n) || length(n) != 1) stop("Argument 'n' must be a numeric scalar.") n <- floor(n) if (n < 2) return(c()) p <- seq(1, n, by=2) q <- length(p) p[1] <- 2 if (n >= 9) { for (k in seq(3, sqrt(n), by=2)) { if (p[(k+1)/2] != 0) p[seq((k*k+1)/2, q, by=k)] <- 0 } } p[p > 0] } pracma/R/detrend.R0000644000176200001440000000207111563500200013456 0ustar liggesusers## ## d e t r e n d . R Remove Linear Trends ## detrend <- function(x, tt = 'linear', bp = c()) { if (!is.numeric(x) && !is.complex(x)) stop("'x' must be a numeric or complex vector or matrix.") trendType <- pmatch(tt, c('constant', 'linear'), nomatch = 0) if (is.vector(x)) x <- as.matrix(x) n <- nrow(x) if (length(bp) > 0 && !all(bp %in% 1:n)) stop("Breakpoints 'bp' must elements of 1:length(x).") if (trendType == 1) { # 'constant' if (!is.null(bp)) warning("Breakpoints not used for 'constant' trend type.") y <- x - matrix(1, n, 1) %*% apply(x, 2, mean) } else if (trendType == 2) { # 'linear' bp <- sort(unique(c(0, c(bp), n-1))) lb <- length(bp) - 1 a <- cbind(matrix(0, n, lb), matrix(1, n, 1)) for (kb in 1:lb) { m <- n - bp[kb] a[(1:m) + bp[kb], kb] <- as.matrix(1:m)/m } y <- x - a %*% qr.solve(a, x) } else { stop("Trend type 'tt' must be 'constant' or 'linear'.") } return(y) } pracma/R/gauss_kronrod.R0000644000176200001440000000313611601132520014713 0ustar liggesusers## ## g a u s s _ k r o n r o d . R Gauss-Kronrod Quadrature ## gauss_kronrod <- function(f, a, b, ...) { stopifnot(is.numeric(a), is.numeric(b), length(a) == 1, length(b) == 1, a < b) fun <- match.fun(f) f <- function(x) fun(x, ...) if (!is.finite(f(a)) || !is.finite(f(b))) warning("Function 'f' is not finite at interval boundaries.") eis <- c(2, 4, 6, 8, 10, 12, 14) t15 <- c(-0.9914553711208126, -0.9491079123427585, -0.8648644233597691, -0.7415311855993944, -0.5860872354676911, -0.4058451513773972, -0.2077849550078985, 0.0, 0.2077849550078985, 0.4058451513773972, 0.5860872354676911, 0.7415311855993944, 0.8648644233597691, 0.9491079123427585, 0.9914553711208126) t7 <- t15[eis] c15 <- c(0.02293532201052922, 0.06309209262997855, 0.1047900103222502, 0.1406532597155259, 0.1690047266392679, 0.1903505780647854, 0.2044329400752989, 0.2094821410847278, 0.2044329400752989, 0.1903505780647854, 0.1690047266392679, 0.1406532597155259, 0.1047900103222502, 0.06309209262997855, 0.02293532201052922) c7 <- c(0.1294849661688697, 0.2797053914892767, 0.3818300505051189, 0.4179591836734694, 0.3818300505051189, 0.2797053914892767, 0.1294849661688697) x15 <- 0.5 * ((b - a) * t15 + b + a) x7 <- 0.5 * ((b - a) * t7 + b + a) y15 <- f(x15) y7 <- f(x7) G7 <- sum(c7 * y7) K15 <- sum(c15 * y15) return(list(value = K15 * (b-a)/2, rel.error = abs(G7 - K15))) } pracma/R/pow2.R0000755000176200001440000000120011540452742012730 0ustar liggesusers### ### POW2.R Raise 2 to some power ### pow2 <- function(f, e) { if (!is.numeric(f) && !is.complex(f)) stop("Argument 'f' must be numeric or complex.") if (missing(e)) { e <- f f <- rep(1, length(e)) } else { if (!is.numeric(e) && !is.complex(e)) stop("Argument 'e' must be numeric or complex.") if (is.complex(f) || is.complex(e)) { f <- Re(f) e <- Re(e) warning("Imaginary part of arguments ignored.") } } if (length(f) != length(e)) stop("Arguments 'e' and 'f' must be of same length.") return(f * 2^e) } pracma/R/ode78.R0000644000176200001440000000610612353745103012775 0ustar liggesusers## ## o d e 7 8 . R ODE Solver ## ode78 = function(f, t0, tfinal, y0, ..., atol = 1e-6, hmax = 0.0) { stopifnot(is.numeric(y0), is.numeric(t0), length(t0) == 1, is.numeric(tfinal), length(tfinal) == 1) if (is.vector(y0)) { y0 <- as.matrix(y0) } else if (is.matrix(y0) && ncol(y0) != 1) { stop("Argument 'y0' must be a vector or single column matrix.") } fun <- match.fun(f) f <- function(t, y) fun(t, y, ...) pow <- 1/8 # see p.91 in the Ascher & Petzold if (hmax == 0.0) hmax <- (tfinal - t0)/2.5 # max stepsize # Define the Fehlberg (7,8) coefficients alpha <- as.matrix(c(2/27, 1/9, 1/6, 5/12, 0.5, 5/6, 1/6, 2/3, 1/3, 1, 0, 1)) beta <- matrix( c(2/27, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1/36, 1/12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1/24, 0, 1/8, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5/12, 0, -25/16, 25/16, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.05, 0, 0, 0.25, 0.2, 0, 0, 0, 0, 0, 0, 0, 0, -25/108, 0, 0, 125/108, -65/27, 125/54, 0, 0, 0, 0, 0, 0, 0, 31/300, 0, 0, 0, 61/225, -2/9, 13/900, 0, 0, 0, 0, 0, 0, 2, 0, 0, -53/6, 704/45, -107/9, 67/90, 3, 0, 0, 0, 0, 0, -91/108, 0, 0, 23/108, -976/135, 311/54, -19/60, 17/6, -1/12, 0, 0, 0, 0, 2383/4100, 0, 0, -341/164, 4496/1025, -301/82, 2133/4100, 45/82, 45/164, 18/41, 0, 0, 0, 3/205, 0, 0, 0, 0, -6/41, -3/205, -3/41, 3/41, 6/41, 0, 0, 0, -1777/4100, 0, 0, -341/164, 4496/1025, -289/82, 2193/4100, 51/82, 33/164, 12/41, 0, 1, 0), nrow = 13, ncol = 12, byrow = FALSE) chi <- as.matrix(c(0, 0, 0, 0, 0, 34/105, 9/35, 9/35, 9/280, 9/280, 0, 41/840, 41/840)) psi <- as.matrix(c(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, -1, -1)) # Initialization t <- t0 hmin <- (tfinal - t)/1e20 h <- (tfinal - t)/50 # initial step size guess x <- as.matrix(y0) # ensure x is a column vector ff <- x %*% zeros(1, 13) tout <- t xout <- t(x) tau <- atol * max(Norm(x, Inf), 1) # Main loop using Fehlber (7,8) pair while (t < tfinal && h >= hmin) { if (t + h > tfinal) h <- tfinal - t ff[, 1] <- f(t, x) for (j in 1:12) ff[, j+1] <- f(t + alpha[j]*h, x + h*ff %*% as.matrix(beta[, j])) # estimate the error term gamma1 <- h * 41/840 * ff %*% psi # local truncation error # estimate the error and the acceptable error delta <- Norm(gamma1, Inf); # actual error tau <- atol * max(Norm(x, Inf), 1.0) # allowable error # update solution only if the error is acceptable if (delta <= tau) { t <- t + h x <- x + h * ff %*% chi # "local extrapolation" tout <- c(tout, t) xout <- rbind(xout, t(x)) } # update the step size if (delta == 0.0) delta <- 1e-16 h <- min(hmax, 0.8 * h * (tau/delta)^pow) } if (t < tfinal) warning("Step size grew too small: singularity likely.") return(list(t = tout, y = xout)) } pracma/R/fnorm.R0000644000176200001440000000106312030661377013167 0ustar liggesusers## ## f n o r m .R Function Norm ## fnorm <- function(f, g, x1, x2, p = 2, npoints = 100) { stopifnot(is.numeric(x1), length(x1) == 1, is.numeric(x2), length(x2) == 1, x1 < x2, is.numeric(npoints), length(npoints) == 1, npoints >= 2) f <- match.fun(f) g <- match.fun(g) x <- seq(x1, x2, length.out = npoints) yf <- f(x) yg <- g(x) if (length(yf) != npoints || length(yg) != npoints) stop("Arguments 'f' and 'g' must be vectorized functions.") fd <- Norm(yf - yg, p = p) return(fd) } pracma/R/qpspecial.R0000644000176200001440000000767213403535607014044 0ustar liggesusers## ## q p s p e c i a l . R ## qpspecial <- function(G, x, maxit = 100) { stopifnot(is.numeric(G), is.matrix(G)) m <- nrow(G); n <- ncol(G) if (m*n <= 0) { warning("qpspecial: Matrix 'G' is empty; nothing can be done.") return(list(x = c(), d = c(), q = Inf, niter = 0, info = 2)) } maxit <- max(floor(maxit), 5) e <- matrix(1, n, 1) if (missing(x)) { x <- e } else { x <- as.matrix(c(x)) nx <- length(x) if (any(x < 0) || nx != n) x <- e } idx <- seq(1, (n*n), by = n+1) Q <- t(G) %*% G z <- x y <- 0 eta <- 0.9995 delta <- 3 mu0 <- sum(x*z)/n tolmu <- 1e-5 tolrs <- 1e-5 kmu <- tolmu * mu0 nQ <- norm(Q, "I") + 2 krs <- tolrs * nQ ap <- 0; ad <- 0 for (k in 1:maxit) { r1 <- -Q %*% x + e*y + z r2 <- -1 + sum(x) r3 <- -x * z rs <- norm(rbind(r1, r2), "I") mu <- -sum(r3)/n if (mu < kmu) { if (rs < krs) { niter <- k-1; info <- 0 break } } zdx <- z / x QD <- Q QD[idx] <- QD[idx] + zdx C <- chol(QD) KT <- solve(t(C), e) M <- sum(KT * KT) r4 <- r1 + r3/x r5 <- sum(KT * solve(t(C), r4)) r6 <- r2 + r5 dy <- -r6/M r7 <- r4 + e*dy dx <- solve(C, solve(t(C), r7)) dz <- (r3 - z*dx)/x p <- -x / dx p0 <- p[p > 0] if (length(p0) > 0) { ap <- min(p0, 1) } else { ap <- 1 } p <- -z / dz p0 <- p[p > 0] if (length(p0) > 0) { ad <- min(p0, 1) } else { ad <- 1 } mauff <- sum((x + ap*dx) * (z + ad*dz)) / n sig <- (mauff/mu)^delta r3 <- r3 + sig*mu r3 <- r3 - dx*dz r4 <- r1 + r3/x r5 <- sum(KT * solve(t(C), r4)) r6 <- r2 + r5 dy <- -r6/M r7 <- r4 + e*dy dx <- solve(C, solve(t(C), r7)) dz <- (r3 - z*dx)/x p <- -x / dx p0 <- p[p > 0] if (length(p0) > 0) { ap <- min(p0, 1) } else { ap <- 1 } p <- -z/dz p0 <- p[p > 0] if (length(p0) > 0) { ad <- min(p0, 1) } else { ad <- 1 } x <- x + eta * ap * dx y <- y + eta * ad * dy z <- z + eta * ad * dz } if (k == maxit) info <- 1 x <- pmax(x,0) x <- x/sum(x) d <- G %*% x q <- sum(d * d) list(x = x, d = d, q = q, niter = k, info = info) } qpsolve <- function(d, A, b, meq = 0, tol = 1e-07){ sol <- dvec <- d bvec <- b imeq <- seq_len(meq) Nmat <- NULL wvec <- NULL active <- NULL niter <- 0 repeat{ niter <- niter + 1 viol <- crossprod(A, sol) - bvec viol1 <- viol / pmax(1,abs(bvec)) iim <- viol1[imeq] >= tol if( any(iim) ){ iim <- which(iim) viol[iim] <- -viol[iim] bvec[iim] <- -bvec[iim] A[,iim] <- -A[,iim] } ii <- which.min(viol1)[1] if( viol1[ii] > -tol) break if(ii %in% active) stop("Error in projection") wvec <- c(wvec, 0) active <- c(active, ii) npvec <- A[,ii] if( !is.null(Nmat) ){ rvec <- solve(qr(Nmat, LAPACK=TRUE), npvec) dvec <- npvec - c(Nmat %*% rvec) }else{ dvec <- npvec rvec <- NULL } jj <- rvec > 0 jj[1] <- FALSE tmp <- wvec[jj]/rvec[jj] t1 <- suppressWarnings(min(tmp)) t2 <- -viol[ii]/crossprod(npvec, dvec) t <- min(c(t1, t2)) if( !is.finite(t) || t < 0 || t1 <= t2 ) stop("Error in projection") sol <- sol + t * dvec wvec <- wvec - t * c(rvec, -1) Nmat <- cbind(Nmat, npvec) } sol <- c(sol) val <- 0.5 * sum(sol * sol) - sum(d * sol) return(list(sol = sol, val = val, niter = niter)) } pracma/R/matlab.R0000644000176200001440000000530312764776254013326 0ustar liggesusers## ## m a t l a b . R Matlab Idioms ## matlab <- function() { cat(paste("", "The following functions are emulations of corresponding Matlab functions", "and bear the same signature as their Matlab cousins as far as possible:", " accumarray, acosd, acot, acotd, acoth, acsc, acscd, acsch, and, angle, ans, arrayfun, asec, asecd, asech, asind, atand, atan2d, beep, bernoulli, blank, blkdiag, bsxfun, cart2pol, cart2sph, cd, ceil, circshift, clear, compan, cond, conv, cosd, cot, cotd, coth, cross, csc, cscd, csch, cumtrapz, dblquad, deblank, deconv, deg2rad, detrend, deval, disp, dot, eig, eigint, ellipj, ellipke, eps, erf, erfc, erfcinv, erfcx, erfi, erfinv, errorbar, expint, expm, eye, ezcontour, ezmesh, ezplot, ezpolar, ezsurf, fact, fftshift, figure, findpeaks, findstr, flipdim, fliplr, flipud, fminbnd, fminsearch, fplot, fprintf, fsolve, fzero, gammainc, gcd, geomean, gmres, gradient, hadamard, hankel, harmmean, hilb, histc, humps, hypot, idivide, ifft, ifftshift, inpolygon, integral, integral2, integral3, interp1, interp2, inv, isempty, isprime, kron, legendre, linprog, linspace, loglog, logm, logseq, logspace, lsqcurvefit, lsqlin, lsqnonlin, lsqnonneg, lu, magic, meshgrid, mkpp, mldivide, mod, mrdivide, nchoosek, ndims, nextpow2, nnz, normest, nthroot, null, num2str, numel, ode23, ode23s, ones, or, orth, pascal, pchip, pdist, pdist2, peaks, perms, piecewise, pinv, plotyy, pol2cart,polar, polyfit, polyint, polylog, polyval, pow2, ppval, primes, psi, pwd, quad, quad2d, quadgk, quadl, quadprog, quadv, quiver, rad2deg, randi, randn, randsample, rat, rats, regexp, regexpi, regexpreg, rem, repmat, roots, rosser, rot90, rref, runge, sec, secd, sech, semilogx, semilogy, sinc, sind, size, sortrows, sph2cart, sqrtm, squareform, std, str2num, strcat, strcmp, strcmpi, strfind, strfindi, strjust, subspace, tand, tic, toc, trapz, tril, trimmean, triplequad, triu, vander, vectorfield, ver, what, who, whos, wilkinson, zeros, zeta.", "", "The following Matlab function names have been capitalized in 'pracma' to", "avoid shadowing functions from R base or one of its recommended packages:", " Diag, factors, finds, Fix, Imag, Lcm, Mode, Norm, nullspace (null), Poly, Rank, Real, Reshape, strRep, strTrim, Toeplitz, Trace, uniq (unique).", "", "To use 'ans' instead of 'ans()' (i.e., as is common practice in Matlab)", "type (and similar for other Matlab commands):", " makeActiveBinding('ans', function() .Last.value, .GlobalEnv) makeActiveBinding('who', who, .GlobalEnv)", "", "etc. after loading the 'pracma' package.", "\n", sep = "\n", collapse = "")) invisible(NULL) } pracma/R/romberg.R0000644000176200001440000000257512666362554013526 0ustar liggesusers## ## r o m b e r g . R Romberg Integration ## romberg <- function(f, a, b, maxit = 25, tol = 1e-12, ...) { stopifnot(is.numeric(a), is.numeric(b), length(a) == 1, length(b) == 1) tol <- abs(tol) if (a == b) return(list(value = 0, iter = 0, rel.error = 0)) if (a > b) return(-1 * romberg(f, b, a, tol = tol, ...)) fun <- match.fun(f) f <- function(x) fun(x, ...) eps <- .Machine$double.eps if (!is.finite(f(a))) a <- a + eps * sign(b-a) if (!is.finite(f(b))) b <- b - eps * sign(b-a) I <- matrix(0, nrow = maxit+1, ncol = maxit+1) n <- 1; iter <- 0; err <- 1.0 while (err > tol && iter < maxit) { iter <- iter+1 # inner trapezoid rule with correction term n <- 2 * n h <- (b-a) / n S <- f(a) for (i in 1:(n-1)) { xi <- a + h * i S <- S + 2*f(xi) } S <- (S + f(b)) * h/2 # S <- S - ((f(b)-f(xi)) - (f(a+h)-f(a))) * h/12.0 # truncation errors I[iter+1, 1] <- S # Richardson approximation for (k in 2:(iter+1)) { j <- 2+iter-k I[j,k] <- (4^(k-1)*I[j+1,k-1] - I[j,k-1]) / (4^(k-1)-1) } err <- abs(I[1,iter+1] - I[2,iter]) } if (iter == maxit) warning("Maximum number of iterations has been reached.") return(list(value = I[1, iter+1], iter = iter, rel.error = err)) } pracma/R/fminsearch.R0000644000176200001440000000307413452637217014176 0ustar liggesusers## ## f m i n s e a r c h . R ## fminsearch <- function(fn, x0, ..., lower = NULL, upper = NULL, method = c("Nelder-Mead", "Hooke-Jeeves"), minimize = TRUE, maxiter = 1000, tol = 1e-08) { n <- length(x0) if (!is.numeric(x0) || n == 0) { stop("Argument 'x0' must be a numeric vector.") } else if (n == 1) { stop("Don't use 'fminsearch' for one-dimensional minimization.") } method <- match.arg(method) scl <- if(minimize) 1 else -1 fun <- match.fun(fn) fn <- function(x) scl * fun(x, ...) if ((!is.null(lower) || !is.null(upper)) && method == "Nelder-Mead") { stop("'Nelder-Mead' cannot handle bounds constraints;\n", "Instead, use 'Hooke-Jeeves' with bounds/box constraints.") } if (method == "Nelder-Mead") { # Call Nelder-Mead w/o bounds constraints opt <- nelder_mead(fn, x0, tol = tol, maxfeval = 5*maxiter) } else if (method == "Hooke-Jeeves") { if (is.null(lower) && !is.null(upper)) lower <- rep(-Inf, n) if (!is.null(lower) && is.null(upper)) upper <- rep( Inf, n) # Call Hooke-Jeeves w/o or w/ bounds constraints opt <- hooke_jeeves(x0, fn, lb = lower, ub = upper, tol = tol, maxfeval = 10*maxiter) } else { warning("Unknown Method: use 'Nelder-Mead' or 'Hooke-Jeeves'!") } xopt <- opt$xmin; fopt <- opt$fmin if (! minimize) fopt <- -fopt return(list(xmin = xopt, fmin = fopt, count = opt$count, convergence = 0, info = opt$info)) } pracma/R/meshgrid.R0000644000176200001440000000167611726441722013663 0ustar liggesusers## ## m e s h g r i d . R Generate a Mesh Grid ## meshgrid <- function(x, y = x) { if (!is.numeric(x) || !is.numeric(y)) stop("Arguments 'x' and 'y' must be numeric vectors.") x <- c(x); y <- c(y) n <- length(x) m <- length(y) X <- matrix(rep(x, each = m), nrow = m, ncol = n) Y <- matrix(rep(y, times = n), nrow = m, ncol = n) return(list(X = X, Y = Y)) } peaks <- function(v = 49, w) { stopifnot(is.numeric(v)) if (missing(w)) { if (length(v) == 1 && v >= 1) { mg <- meshgrid(linspace(-3, 3, floor(v))) x <- mg$X; y <- mg$Y } else { mg <- meshgrid(v, v) x <- mg$X; y <- mg$Y } } else { stopifnot(is.numeric(w)) x <- v; y <- w } z <- 3 * (1-x)^2 * exp(-(x^2) - (y+1)^2) - 10 * (x/5 - x^3 - y^5) * exp(-x^2 - y^2) - 1/3 * exp(-(x+1)^2 - y^2) return(list(X = x, Y = y, Z = z)) } pracma/R/pinv.R0000644000176200001440000000113014072313323013006 0ustar liggesusers## ## p i n v . R Pseudoinverse (Moore-Penrose Generalized Inverse) ## pinv <- function (A, tol = .Machine$double.eps^(2/3)) { stopifnot(is.numeric(A) || is.complex(A), is.matrix(A)) s <- svd(A) # D <- diag(s$d); Dinv <- diag(1/s$d) # U <- s$u; V <- s$v # A = U D V' # X = V Dinv U' p <- ( s$d > max(tol * s$d[1], 0) ) if (all(p)) { mp <- s$v %*% (1/s$d * t(s$u)) } else if (any(p)) { mp <- s$v[, p, drop=FALSE] %*% (1/s$d[p] * t(s$u[, p, drop=FALSE])) } else { mp <- matrix(0, nrow=ncol(A), ncol=nrow(A)) } return(mp) } pracma/R/sici.R0000644000176200001440000000463113340332672012777 0ustar liggesusers## ## s i c i . R Sine and cosine integral functions ## Si <- function(x) { stopifnot(is.numeric(x)) sapply(x, .sici)[1, ] } Ci <- function(x) { stopifnot(is.numeric(x)) sapply(x, .sici)[2, ] } .sici <- function(x) { stopifnot(is.numeric(x), length(x) == 1) bj <- numeric(101) p2 <- 1.570796326794897 # pi/2 el <- 0.5772156649015329 # gamma epsi <- 1.0e-15 x2 <- x * x if (x >= 0.0) sgnx <- 1L else {sgnx <- -1L; x <- sgnx * x} # start the computation if (x == 0.0) { si <- 0.0; ci <- -Inf } else if (x <= 16.0) { xr <- -0.25 * x2 ci <- el + log(x) + xr for (k in 2:40) { xr <- -0.5 * xr * (k-1)/(k*k*(2*k-1)) * x2 ci <- ci + xr if (abs(xr) < abs(ci) * epsi) break } xr <- x si <- x for (k in 1:40) { xr <- -0.5 * xr * (2*k-1) / k / (4*k*k + 4*k + 1) * x2 si <- si + xr if (abs(xr) < abs(si) * epsi) break } } else if (x < 32.0) { m <- floor(47.2 + 0.82 * x) xa1 <- 0.0 xa0 <- 1e-100 for (k in m:1) { xa <- 4.0 * k * xa0/x - xa1 bj[k] <- xa xa1 <- xa0 xa0 <- xa } xs <- bj[1] for (k in seq(3, m, by=2)) { xs <- xs + 2.0 * bj[k] } bj[1] <- bj[1] / xs for (k in 2:m) { bj[k] <- bj[k] / xs } xr <- 1.0 xg1 <- bj[1] for (k in 2:m) { xr <- 0.25 * xr * (2.0*k-3.0)^2 / ((k-1)*(2*k-1)^2) * x xg1 <- xg1 + bj[k] * xr } xr <- 1.0 xg2 <- bj[1] for (k in 2:m) { xr <- 0.25 * xr * (2*k-5)^2 / ((k-1)*(2*k-3)^2) * x xg2 <- xg2 + bj[k] * xr } xcs <- cos(x/2.0) xss <- sin(x/2.0) ci <- el + log(x) - x * xss * xg1 + 2 * xcs * xg2 - 2 * xcs * xcs si <- x * xcs * xg1 + 2 * xss * xg2 - sin(x) } else { xr <- 1.0 xf <- 1.0 for (k in 1:9) { xr <- -2.0 * xr * k * (2*k-1) / x2 xf <- xf + xr } xr <- 1.0/x xg <- xr for (k in 1:8) { xr <- -2.0 * xr * (2*k+1) * k / x2 xg <- xg + xr } ci <- xf * sin(x) / x - xg * cos(x) / x si <- p2 - xf * cos(x) / x - xg * sin(x) / x } si <- sgnx * si return( c(si, ci) ) } pracma/R/runge.R0000644000176200001440000000013011547665714013173 0ustar liggesusers## ## r u n g e . R Runge Function ## runge <- function(x) { 1 / (1 + (5*x)^2) }pracma/R/circlefit.R0000644000176200001440000000134113630250433014003 0ustar liggesusers## ## c i r c l e f i t . R Fitting a Circle ## circlefit <- function(xp, yp, fast = TRUE) { if (!is.vector(xp, mode="numeric") || !is.vector(yp, mode="numeric")) stop("Arguments 'xp' and 'yp' must be numeric vectors.") if (length(xp) != length(yp)) stop("Vectors 'xp' and 'yp' must be of the same length.") if (!fast) warning("Option 'fast' is deprecated and will not be used!", call. = FALSE, immediate. = TRUE) n <- length(xp) p <- qr.solve(cbind(xp, yp, 1), matrix(xp^2 + yp^2, ncol = 1)) v <- c(p[1]/2, p[2]/2, sqrt((p[1]^2 + p[2]^2)/4 + p[3])) rms <- sqrt(sum((sqrt((xp-v[1])^2 + (yp-v[2])^2) - v[3])^2)/n) cat("RMS error:", rms, "\n") return(v) } pracma/R/diag.R0000644000176200001440000000146312001565513012747 0ustar liggesusers## ## d i a g . R Matrix diagonal ## Diag <- function(x, k=0) { if (!is.numeric(x) && !is.complex(x)) stop("Argument 'x' must be a real or complex vector or matrix.") if (!is.numeric(k) || k != round(k)) stop("Argument 'k' must be an integer.") # if (length(x) == 1) return(x) if (is.matrix(x)) { n <- nrow(x); m <- ncol(x) if (k >= m || -k >= n) { y <- matrix(0, nrow=0, ncol=0) } else { y <- x[col(x) == row(x) + k] } } else { if (is.vector(x)) { n <- length(x) m <- n + abs(k) y <- matrix(0, nrow=m, ncol=m) y[col(y) == row(y) + k] <- x } else { stop("Argument 'x' must be a real or complex vector or matrix.") } } return(y) } pracma/R/blkdiag.R0000644000176200001440000000107411540452742013444 0ustar liggesusersblkdiag <-function(...) { dots <- list(...) if (! all(sapply(dots, is.matrix)) || ! all(sapply(dots, is.numeric)) ) stop("All input arguments in '...' must be numeric matrices") nrows <- sapply(dots, nrow) ncols <- sapply(dots, ncol) if (any(nrows == 0) || any(ncols == 0)) stop("All input matrices '...' must be non-empty.") n <- sum(nrows) N <- c(0, cumsum(nrows)) m <- sum(ncols) M <- c(0, cumsum(ncols)) A <- matrix(0, nrow = n, ncol = m) k <- length(dots) for (i in 1:k) { A[(N[i]+1):N[i+1], (M[i]+1):M[i+1]] <- dots[[i]] } return(A) } pracma/R/newton.R0000644000176200001440000000460013342034603013351 0ustar liggesusers## ## n e w t o n . R Newton Root finding ## newtonRaphson <- function(fun, x0, dfun = NULL, maxiter = 500, tol = 1e-08, ...) { # Newton method for finding function zeros stopifnot(is.function(fun)) if (is.null(dfun)) { dfun <- function(x, ...) { h <- tol^(2/3) (fun(x+h, ...) - fun(x-h, ...)) / (2*h) } } x <- x0 fx <- fun(x, ...) dfx <- dfun(x, ...) niter <- 0 diff <- tol + 1 while (diff >= tol && niter <= maxiter) { niter <- niter + 1 if (dfx == 0) { warning("Slope is zero: no further improvement possible.") break } diff <- - fx/dfx x <- x + diff diff <- abs(diff) fx <- fun(x, ...) dfx <- dfun(x, ...) } if (niter > maxiter) { warning("Maximum number of iterations 'maxiter' was reached.") } return(list(root=x, f.root=fx, niter=niter, estim.prec=diff)) } # alias newton <- newtonRaphson halley <- function(fun, x0, maxiter = 500, tol = 1e-08, ...) { fun <- match.fun(fun) f <- function(x) fun(x, ...) f0 <- f(x0) if (abs(f0) < tol^(3/2)) return(list(root = x0, f.root = f0, maxiter = 0, estim.prec = 0)) f1 <- fderiv(f, x0, 1) f2 <- fderiv(f, x0, 2) x1 <- x0 - 2*f0*f1 / (2*f1^2 - f0*f2) niter = 1 while (abs(x1 - x0) > tol && niter < maxiter) { x0 <- x1 f0 <- f(x0) f1 <- fderiv(f, x0, 1) f2 <- fderiv(f, x0, 2) x1 <- x0 - 2*f0*f1 / (2*f1^2 - f0*f2) niter <- niter + 1 } return(list(root = x1, f.root = f(x1), iter = niter, estim.prec = abs(x1 - x0))) } newtonHorner <- function(p, x0, maxiter = 50, tol = .Machine$double.eps^0.5) { n <- length(p) - 1 niter <- 0 x <- x0 diff <- 1 + tol while (niter <= maxiter && diff >= tol) { H <- horner(p, x) if (abs(H$dy) <= tol) { warning("Newton's method encountered a slope almost zero.") return(list(root = NULL, f.root = NULL, deflate = NULL, iters = niter, estim.prec = Inf)) } xnew <- x - H$y / H$dy diff <- abs(x - xnew) niter <- niter + 1 x <- xnew } if (niter > maxiter) { warning("Maximum number of iterations exceeded.") } defl <- hornerdefl(p, x) return(list(root = x, f.root = defl$y, deflate = defl$q, iters = niter, estim.prec = diff)) } pracma/R/rank.R0000644000176200001440000000173712060137756013013 0ustar liggesusers## ## r a n k . R Matrix Rank ## Rank <- function(M) { if (length(M) == 0) return(0) if (!is.numeric(M)) stop("Argument 'M' must be a numeric matrix.") if (is.vector(M)) M <- matrix(c(M), nrow = length(M), ncol = 1) # The MASS way r1 <- qr(M)$rank # The Matlab way sigma <- svd(M)$d tol <- max(dim(M)) * max(sigma) * .Machine$double.eps r2 <- sum(sigma > tol) if (r1 != r2) warning("Rank calculation may be problematic.") return(r2) } nullspace <- function(M) { if (!is.numeric(M)) stop("Argument 'M' must be a numeric matrix.") if (is.vector(M)) M <- matrix(c(M), nrow = length(M), ncol = 1) qrM <- qr(t(M)) rnk <- qrM$rank if (rnk == ncol(M)) return(NULL) inds <- if (rnk == 0) 1:ncol(M) else -(1:rnk) qrQ <- qr.Q(qrM, complete = TRUE)[, inds, drop = FALSE] if (length(qrQ) == 0) return(NULL) else return(qrQ) } null <- nullspace pracma/R/rationalfit.R0000644000176200001440000000344112001565513014355 0ustar liggesusersrationalfit <- function(x, y, d1 = 5, d2 = 5) { stopifnot(is.numeric(x), is.numeric(y)) n <- length(x) if (n <= 2) stop("Length of arguments 'x' and 'y' must be greater than 2.") if (length(y) != n) stop("Arguments 'x' ans 'y' must be of the same length.") if (is.unsorted(x)) stop("Argument 'x' must be a sorted vector") p <- finds(!is.finite(y)) dinf <- c() while (length(p) > 0) { y <- y * (x - x[p[1]]) # adjust remaining y values y <- y[-p[1]] # remove bad y value, now a NaN dinf <- c(dinf, x[p[1]]) # remember where pole was x <- x[-p[1]] # now remove that x value too if (d2 > 0) d2 <- d2 - 1 # reduce expected order of den p <- finds(!is.finite(y)) # have all Inf values been removed yet? } yy <- length(y) # x and y have a new length an <- outer(x, d1:0, "^") # vandermonde matrix ad <- outer(x, d2:0, "^") for (k in 1:yy) ad[k, ] <- y[k] * ad[k, ] # A is basically N-y*D A <- cbind(an, -ad) # LS solution is in the null space of A V <- svd(A, nv = ncol(A))$v # [u,s,v]=svd(A); % null space is in the cols of V ND <- V[, ncol(A)] # use the "most null" vector N <- ND[1:(d1+1)] D <- ND[(d1+2):length(ND)] D1 <- D[1] if (D1 == 0) D1 <- 1 N <- N/D1 D <- D/D1 D <- Poly(c(dinf, roots(D))) # and then add the removed +/- Inf poles back in eps <- .Machine$double.eps # remove small imaginary parts if (all(Im(D) < eps)) D <- Re(D) maxd <- max(abs(D)) # normalize max Den value to be +/- 1 if (maxd == 0) maxd <- 1 N <- N/maxd D <- D/maxd return(list(p1 = N, p2 = D)) } pracma/R/polyApprox.R0000644000176200001440000000143112627566477014243 0ustar liggesusers## ## p o l y A p p r o x . R Polynomial Approximation ## polyApprox <- function(f, a, b, n, ...) { if (!is.numeric(a) || !is.numeric(b) || !is.numeric(n) || length(a) != 1 || length(b) != 1 || length(n) != 1 || a >= b || n <= 0) stop("One of arguments 'a', 'b', or 'n' incorrectly chosen.") f1 <- match.fun(f) f <- function(x) f1(x, ...) # Compute the Chebyshev coefficients cP <- chebPoly(n) cC <- chebCoeff(f, a, b, n) pC <- drop(cC %*% cP) c0 <- cC[1] # Compute the corresponding polynomial q <- c(2, -(b+a))/(b-a) p <- polytrans(pC, q) p <- polyadd(p, c(-c0/2)) rf <- function(x) polyval(p, x) ep <- fnorm(f, rf, a, b, p = Inf) return(list(p = p, f = rf, cheb.coeff = pC, estim.prec = ep)) } pracma/R/fibsearch.R0000644000176200001440000000245211546666270014007 0ustar liggesusers## ## f i b s e a r c h . R Fibonacci Search ## fibsearch <- function(f, a, b, ..., endp = FALSE, tol = .Machine$double.eps^(1/2)) # Fibonacci search for a univariate function minimum in a bounded interval { if (a >= b) stop("Left endpoint a must be smaller than b.") tol <- max(tol, .Machine$double.eps) # Compute Fibonacci numbers [F0,] F1, F2, ..., Fm F <- c(1, 2); n <- 2 while (F[n] <= 2*(b-a)/tol) { F[n+1] <- F[n] + F[n-1]; n <- n + 1 } # Initialize values (k == 0) x1 <- a; x2 <- b xa <- a + (b-a) * F[n-2]/F[n]; fxa <- f(xa, ...) xb <- a + (b-a) * F[n-1]/F[n]; fxb <- f(xb, ...) # Compute iteration k <- 1 while (k <= n-3 && xa < xb && (x2 - x1) >= tol) { if (fxa > fxb) { x1 <- xa; xa <- xb xb <- x1 + (x2-x1) * F[n-k-1]/F[n-k] fxa <- fxb; fxb <- f(xb, ...) } else { x2 <- xb; xb <- xa xa <- x1 + (x2-x1) * F[n-k-2]/F[n-k] fxb <- fxa; fxa <- f(xa, ...) } k <- k + 1 } # Finally use the mean and consider endpoints xmin <- (xa+xb)/2; fmin <- f(xmin, ...) if (endp) { fa <- f(a, ...); fb <- f(b, ...) if (xmin-a < tol && fa < fmin) { xmin <- a; fmin <- fa } else { if (b - xmin < tol && fb < fmin) { xmin <- b; fmin <- fb } } } estim.prec <- max(xmin-x1, x2-xmin) return(list(xmin=xmin, fmin=fmin, niter=k, estim.prec=estim.prec)) } pracma/R/cart2sph.R0000644000176200001440000000576211667447255013622 0ustar liggesusers## ## c a r t 2 s p h . R Coordinate Transformations ## cart2sph <- function(xyz) { stopifnot(is.numeric(xyz)) # Transform cartesian to spherical coordinates if (is.vector(xyz) && length(xyz) == 3) { x <- xyz[1]; y <- xyz[2]; z <- xyz[3] m <- 1 } else if (is.matrix(xyz) && ncol(xyz) == 3) { x <- xyz[, 1]; y <- xyz[, 2]; z <- xyz[, 3] m <- nrow(xyz) } else stop("Input must be a vector of length 3 or a matrix with 3 columns.") hypotxy <- hypot(x, y) r <- hypot(hypotxy, z) phi <- atan2(z, hypotxy) theta <- atan2(y, x) if (m == 1) tpr <- c(theta, phi, r) else tpr <- cbind(theta, phi, r) return(tpr) } sph2cart <- function(tpr) { stopifnot(is.numeric(tpr)) # Transform spherical to cartesian coordinates if (is.vector(tpr) && length(tpr) == 3) { theta <- tpr[1]; phi <- tpr[2]; r <- tpr[3] m <- 1 } else if (is.matrix(tpr) && ncol(tpr) == 3) { theta <- tpr[, 1]; phi <- tpr[, 2]; r <- tpr[, 3] m <- nrow(tpr) } else stop("Input must be a vector of length 3 or a matrix with 3 columns.") z <- r * sin(phi) tmp <- r * cos(phi) x <- tmp * cos(theta) y <- tmp * sin(theta) if (m == 1) xyz <- c(x, y, z) else xyz <- cbind(x, y, z) return(xyz) } cart2pol <- function(xyz) { stopifnot(is.numeric(xyz)) # Transform cartesian to cylindrical or polar coordinates if (is.vector(xyz) && (length(xyz) == 2 || length(xyz) == 3)) { x <- xyz[1]; y <- xyz[2] m <- 1; n <- length(xyz) } else if (is.matrix(xyz) && (ncol(xyz) == 2 || ncol(xyz) == 3)) { x <- xyz[, 1]; y <- xyz[, 2] m <- nrow(xyz); n <- ncol(xyz) } else stop("Input must be a vector of length 3 or a matrix with 3 columns.") phi <- atan2(y, x) r <- hypot(x, y) if (n == 2) { if (m == 1) prz <- c(phi, r) else prz <- cbind(phi, r) } else { if (m == 1) { z <- xyz[3] prz <- c(phi, r, z) } else { z <- xyz[, 3] prz <- cbind(phi, r, z) } } return(prz) } pol2cart <- function(prz) { stopifnot(is.numeric(prz)) # Transform polar or cylindrical to cartesian coordinates if (is.vector(prz) && (length(prz) == 2 || length(prz) == 3)) { phi <- prz[1]; r <- prz[2] m <- 1; n <- length(prz) } else if (is.matrix(prz) && (ncol(prz) == 2 || ncol(prz) == 3)) { phi <- prz[, 1]; r <- prz[, 2] m <- nrow(prz); n <- ncol(prz) } else stop("Input must be a vector of length 3 or a matrix with 3 columns.") x <- r * cos(phi) y <- r * sin(phi) if (n == 2) { if (m == 1) xyz <- c(x, y) else xyz <- cbind(x, y) } else { if (m == 1) { z <- prz[3] xyz <- c(x, y, z) } else { z <- prz[, 3] xyz <- cbind(x, y, z) } } return(xyz) } pracma/R/steep_descent.R0000644000176200001440000000353414072313323014671 0ustar liggesusers## ## s t e e p _ d e s c e n t . R Minimization by Steepest Descent ## steep_descent <- function (x0, f, g = NULL, info = FALSE, maxiter = 100, tol = .Machine$double.eps^(1/2)) { eps <- .Machine$double.eps if (! is.numeric(x0)) stop("Argument 'x0' must be a numeric vector.") n <- length(x0) # User provided or numerical gradient f <- match.fun(f) if (is.null(g)) g <- function(x) grad(f, x) else g <- match.fun(g) if (info) cat(0, "\t", x0, "\n") x <- x0 k <- 1 while (k <= maxiter) { f1 <- f(x) g1 <- g(x) z1 <- sqrt(sum(g1^2)) if (z1 == 0) { warning( paste("Zero gradient at:", x, f1, "-- not applicable.\n")) return(list(xmin = NA, fmin = NA, niter = k)) } # else use gradient as unit vector g1 <- g1 / z1 a1 <- 0 a3 <- 1; f3 <- f(x - a3*g1) # Find a minimum on the gradient line (or line search) while (f3 >= f1) { a3 <- a3/2; f3 <- f(x - a3*g1) if (a3 < tol/2) { if (info) cat("Method of steepest descent converged to:", x, "\n") x[abs(x) < eps] <- 0 return(list(xmin = x, fmin = f(x), niter = k)) } } # Check an intermediate point (for faster convergence) a2 <- a3/2; f2 <- f(x - a2*g1) h1 <- (f2 - f1)/a2 h2 <- (f3 -f2)/(a3 - a2) h3 <- (h2 - h1)/a3 a0 <- 0.5*(a2 - h1/h3); f0 <- f(x - a0*g1) if (f0 < f3) a <- a0 else a <- a3 x <- x - a*g1 if (info) cat(k, "\t", x, "\n") k <- k + 1 } if(k > maxiter) warning("Maximum number of iterations reached -- not converged.\n") return(list(xmin = NA, fmin = NA, niter = k)) } pracma/R/nextpow2.R0000755000176200001440000000044411540452742013640 0ustar liggesusers### ### NEXTPOW2.R Next higher power of 2 ### nextpow2 <- function(x) { if (is.null(x) || length(x) == 0) return(c()) if (!is.numeric(x) && !is.complex(x)) stop("Argument 'x' must be a numeric/complex vector/matrix.") x[x == 0] <- 1 return(ceiling(log2(abs(x)))) } pracma/R/findintervals.R0000644000176200001440000000076111567677214014735 0ustar liggesusers## ## f i n d i n t e r v a l s . R Find Interval Indices ## findintervals <- function(x, xs) { if (length(x) == 0 || length(xs) == 0) return(c()) if (!is.vector(x, mode="numeric") || !is.vector(x, mode="numeric")) stop("Arguments 'x' and 'xs' must be numeric vectors.") if (length(x) != 1) stop("Length of vector 'x' must be 1.") n <- length(xs) xsx <- xs - x i0 <- which(xsx == 0) i1 <- which(xsx[1:(n-1)] * xsx[2:n] < 0) return(sort(c(i0, i1))) } pracma/R/ellip.R0000644000176200001440000000542412060626424013155 0ustar liggesusers## ## e l l i p . R Elliptic Integrals ## ellipke <- function(m, tol = .Machine$double.eps) { stopifnot(is.numeric(m)) m <- c(m) if (any(m < 0) || any(m > 1)) stop("Some elements of argument 'm' are out of range.") a0 <- 1 b0 <- sqrt(1-m) s0 <- m i1 <- 0 mm <- 1 while (mm > tol) { a1 <- (a0+b0)/2 b1 <- sqrt(a0*b0) c1 <- (a0-b0)/2 i1 <- i1 + 1 w1 <- 2^i1 * c1^2 mm <- max(w1) s0 <- s0 + w1 a0 <- a1 b0 <- b1 } k <- pi / (2*a1) e <- k * (1-s0/2) im <- finds(m == 1) if (!isempty(im)) { e[im] <- ones(length(im), 1) k[im] <- Inf } return(list(k = k, e = e)) } ## Jacobi elliptic functions ellipj <- function(u, m, tol = .Machine$double.eps) { stopifnot(is.numeric(u), is.numeric(m) || is.complex(m)) u <- c(u); m <- c(m) if (length(u) == 1) { u <- rep(u, length(m)) } else if (length(m) == 1) { m <- rep(m, length(u)) } else { if (length(u) != length(m)) stop("Arguments 'u' and 'm' must be of the same length.") } if (any(m < 0) || any(m > 1)) stop("Some elements of argument 'm' are out of range.") mmax <- length(u); chunk <- 10 cn <- sn <- dn <- numeric(mmax) a <- b <- cc <- matrix(0, nrow = chunk, ncol = mmax) a[1, ] <- 1 b[1, ] <- sqrt(1-m) cc[1, ] <- sqrt(m) n <- numeric(mmax) i <- 1 while (any(abs(cc[i, ]) > tol)) { i <- i + 1 if (i > nrow(a)) { a <- rbind(a, matrix(0, chunk, mmax)) b <- rbind(b, matrix(0, chunk, mmax)) cc <- rbind(cc, matrix(0, chunk, mmax)) } a[i, ] <- 0.5 * (a[i-1, ] + b[i-1, ]) b[i, ] <- sqrt(a[i-1, ] * b[i-1, ]) cc[i, ] <- 0.5 * (a[i-1, ] - b[i-1, ]) inds <- which(abs(cc[i, ]) <= tol & abs(cc[i-1, ]) > tol) if (!isempty(inds)) { mi <- 1; ni <- length(inds) # [mi,ni] <- size(inds) n[inds] <- rep(i-1, ni) # repmat((i-1), mi, ni) } } phin <- matrix(0, nrow = i, ncol = mmax) phin[i, ] <- 2^n * a[i, ] * u while (i > 1) { i <- i - 1 inds <- which(n >= i) phin[i, ] <- phin[i+1, ] if (!isempty(inds)) { phin[i, inds] <- 0.5 * (asin(cc[i+1, inds] * sin(phin[i+1, inds] %% (2*pi)) / a[i+1, inds]) + phin[i+1,inds]) } } # the general case sn <- sin(phin[1, ] %% (2*pi)) cn <- cos(phin[1, ] %% (2*pi)) dn <- sqrt(1 - m * sn^2) # some special cases m1 <- which(m == 1) # special case m = 1 sn[m1] <- tanh(u[m1]) cn[m1] <- sech(u[m1]) dn[m1] <- sech(u[m1]) dn[m == 0] <- 1 # special case m = 0 return(list(sn = sn, cn = cn, dn = dn)) } pracma/R/hookejeeves.R0000755000176200001440000002102113377264142014360 0ustar liggesusers## ## h o o k e j e e v e s . R Hooke-Jeeves Minimization ## hooke_jeeves <- function(x0, fn, ..., lb = NULL, ub = NULL, tol = 1e-08, maxfeval = 10000, target = Inf, info = FALSE) { if (!is.numeric(x0)) stop("Argument 'x0' must be a numeric vector.") n <- length(x0) if (n == 1) stop("Do not use Hooke-Jeeves for univariate functions.") fun <- match.fun(fn) f <- function(x) fun(x, ...) if (is.null(lb) && is.null(ub)) { result <- .hj(x0, f, tol, target, maxfeval, info) } else { if (is.null(lb)) lb <- -Inf if (is.null(ub)) ub <- Inf if(!is.numeric(lb) || !is.numeric(ub)) stop("Lower and upper limits must be numeric.", call. = FALSE) if (length(lb) == 1) lb <- rep(lb, n) if (length(ub) == 1) ub <- rep(ub, n) if (!all(lb <= ub)) stop("All lower limits must be smaller than upper limits.", call. = FALSE) if (!all(lb <= x0) || !all(x0 <= ub)) stop("Infeasible starting values -- check limits.", call. = FALSE) result <- .hjb(x0, f, lb, ub, tol, target, maxfeval, info) } res <- list(xmin = result$xmin, fmin = result$fmin, count = result$fcalls, convergence = 0, info = list(solver = "Hooke-Jeeves", iterations = result$niter)) return(res) } .hj <- function(x0, f, tol, target, maxfeval, info) { n = length(x0) #-- Setting steps and stepsize ----- nsteps <- floor(log2(1/tol)) # number of steps steps <- 2^c(-(0:(nsteps-1))) # decreasing step size dir <- diag(1, n, n) # orthogonal directions x <- x0 # start point fx <- fbest <- f(x) # smallest value so far fcount <- 1 # counts number of function calls if (info) cat("step\tnofc\tfmin\txpar\n") # info header #-- Start the main loop ------------ ns <- 0 while (ns < nsteps && fcount < maxfeval && abs(fx) < target) { ns <- ns + 1 hjs <- .hjsearch(x, f, steps[ns], dir, fcount, maxfeval, target) x <- hjs$x fx <- hjs$fx sf <- hjs$sf fcount <- fcount + hjs$finc if (info) cat(ns, "\t", fcount, "\t", fx, "\t", x[1], "...\n") } if (fcount > maxfeval) { warning("Function evaluation limit exceeded -- may not converge.") conv <- 1 } else if (abs(fx) > target) { warning("Function exceeds min/max value -- may not converge.") conv <- 1 } else { conv <- 0 } return(list(xmin = x, fmin = fx, fcalls = fcount, niter = ns, convergence = conv)) } ## Search with a single scale ----------------------------- .hjsearch <- function(xb, f, h, dir, fcount, maxfeval, target) { x <- xb xc <- x sf <- 0 finc <- 0 hje <- .hjexplore(xb, xc, f, h, dir) x <- hje$x fx <- hje$fx sf <- hje$sf finc <- finc + hje$numf # Pattern move while (sf == 1) { d <- x-xb xb <- x xc <- x+d fb <- fx hje <- .hjexplore(xb, xc, f, h, dir, fb) x <- hje$x fx <- hje$fx sf <- hje$sf finc <- finc + hje$numf if (sf == 0) { # pattern move failed hje <- .hjexplore(xb, xb, f, h, dir, fb) x <- hje$x fx <- hje$fx sf <- hje$sf finc <- finc + hje$numf } if (fcount + finc > maxfeval || abs(fx) > target) break } return(list(x = x, fx = fx, sf = sf, finc = finc)) } ## Exploratory move --------------------------------------- .hjexplore <- function(xb, xc, f, h, dir, fbold) { n <- length(xb) x <- xb if (missing(fbold)) { fb <- f(x) numf <- 1 } else { fb <- fbold numf <- 0 } fx <- fb xt <- xc sf <- 0 # do we find a better point ? dirh <- h * dir fbold <- fx for (k in sample.int(n, n)) { # resample orthogonal directions p1 <- xt + dirh[, k] ft1 <- f(p1) numf <- numf + 1 p2 <- xt - dirh[, k] ft2 <- f(p2) numf <- numf + 1 if (min(ft1, ft2) < fb) { sf <- 1 if (ft1 < ft2) { xt <- p1 fb <- ft1 } else { xt <- p2 fb <- ft2 } } } if (sf == 1) { x <- xt fx <- fb } return(list(x = x, fx = fx, sf = sf, numf = numf)) } .hjb <- function(x0, f, lower, upper, tol, target, maxfeval, info) { n <- length(x0) # checking lower and upper bounds if(!is.numeric(lower) || !is.numeric(upper)) stop("Lower and upper limits must be numeric.", call. = FALSE) if (length(lower) == 1) lower <- rep(lower, n) if (length(upper) == 1) upper <- rep(upper, n) if (!all(lower <= upper)) stop("All lower limits must be smaller than upper limits.", call. = FALSE) if (!all(lower <= x0) || !all(x0 <= upper)) stop("Infeasible starting values -- check limits.", call. = FALSE) #-- Setting steps and stepsize ----- nsteps <- floor(log2(1/tol)) # number of steps steps <- 2^c(-(0:(nsteps-1))) # decreasing step size dir <- diag(1, n, n) # orthogonal directions x <- x0 # start point fx <- fbest <- f(x) # smallest value so far fcount <- 1 # counts number of function calls if (info) cat("step\tnofc\tfmin\txpar\n") # info header #-- Start the main loop ------------ ns <- 0 while (ns < nsteps && fcount < maxfeval && abs(fx) < target) { ns <- ns + 1 hjs <- .hjbsearch(x, f, lower, upper, steps[ns], dir, fcount, maxfeval, target) x <- hjs$x fx <- hjs$fx sf <- hjs$sf fcount <- fcount + hjs$finc if (info) cat(ns, "\t", fcount, "\t", fx, "\t", x[1], "...\n") } if (fcount > maxfeval) { warning("Function evaluation limit exceeded -- may not converge.") conv <- 1 } else if (abs(fx) > target) { warning("Function exceeds min/max value -- may not converge.") conv <- 1 } else { conv <- 0 } return(list(xmin = x, fmin = fx, fcalls = fcount, niter = ns, convergence = conv)) } ## Search with a single scale ----------------------------- .hjbsearch <- function(xb, f, lo, up, h, dir, fcount, maxfeval, target) { x <- xb xc <- x sf <- 0 finc <- 0 hje <- .hjbexplore(xb, xc, f, lo, up, h, dir) x <- hje$x fx <- hje$fx sf <- hje$sf finc <- finc + hje$numf # Pattern move while (sf == 1) { d <- x-xb xb <- x xc <- x+d xc <- pmax(pmin(xc, up), lo) fb <- fx hje <- .hjbexplore(xb, xc, f, lo, up, h, dir, fb) x <- hje$x fx <- hje$fx sf <- hje$sf finc <- finc + hje$numf if (sf == 0) { # pattern move failed hje <- .hjbexplore(xb, xb, f, lo, up, h, dir, fb) x <- hje$x fx <- hje$fx sf <- hje$sf finc <- finc + hje$numf } if (fcount + finc > maxfeval || abs(fx) > target) break } return(list(x = x, fx = fx, sf = sf, finc = finc)) } ## Exploratory move --------------------------------------- .hjbexplore <- function(xb, xc, f, lo, up, h, dir, fbold) { n <- length(xb) x <- xb if (missing(fbold)) { fb <- f(x) numf <- 1 } else { fb <- fbold numf <- 0 } fx <- fb xt <- xc sf <- 0 # do we find a better point ? dirh <- h * dir fbold <- fx for (k in sample.int(n, n)) { # resample orthogonal directions p1 <- xt + dirh[, k] if ( p1[k] <= up[k] ) { ft1 <- f(p1) numf <- numf + 1 } else { ft1 <- fb } p2 <- xt - dirh[, k] if ( lo[k] <= p2[k] ) { ft2 <- f(p2) numf <- numf + 1 } else { ft2 <- fb } if (min(ft1, ft2) < fb) { sf <- 1 if (ft1 < ft2) { xt <- p1 fb <- ft1 } else { xt <- p2 fb <- ft2 } } } if (sf == 1) { x <- xt fx <- fb } return(list(x = x, fx = fx, sf = sf, numf = numf)) } pracma/R/modular.R0000644000176200001440000000465613070014412013507 0ustar liggesusers## ## m o d u l a r . R Modular functions ## ceil <- function(n) ceiling(n) Fix <- function(n) trunc(n) mod <- function(n, m) { stopifnot(is.numeric(n), is.numeric(m)) if (length(m) != 1 || floor(m) != ceiling(m)) stop("Argument 'm' must be an integer scalar.") if (m == 0) return(n) else return(n %% m) } rem <- function(n, m) { stopifnot(is.numeric(n), is.numeric(m)) if (length(m) != 1 || floor(m) != ceiling(m)) stop("Argument 'm' must be an integer scalar.") if (m == 0) return(NaN) k <- mod(n, m) l <- which(k != 0 & sign(n)*sign(m) < 0) k[l] <- k[l] - m return(k) } idivide <- function(n, m, rounding = c("fix", "floor", "ceil", "round")) { stopifnot(is.numeric(n), is.numeric(m)) rounding <- match.arg(rounding) if (length(n) == 1) { n <- rep(n, length(m)) } else if (length(m) == 1) { m <- rep(m, length(n)) } ln <- length(n); lm <- length(m) if (ln != lm) stop("Arguments 'n', 'm' must be scalars or have the same length.") if (any(floor(n) != ceiling(n)) || any(floor(m) != ceiling(m))) stop("Arguments 'n', 'm' must be integers or vectors of integers.") k <- n / m if (rounding == "fix") k <- Fix(k) else if (rounding == "floor") k <- floor(k) else if (rounding == "ceil") k <- ceil(k) else if (rounding == "round") k <- round(k) else stop("Rounding must be one of 'fix', 'floor', 'ceil', 'round'.") return(k) } gcd <- function(a, b, extended = FALSE) { stopifnot(is.numeric(a), is.numeric(b)) if (length(a) == 1) { a <- rep(a, times=length(b)) } else if (length(b) == 1) { b <- rep(b, times=length(a)) } n <- length(a) e <- d <- g <- numeric(n) for (k in 1:n) { u <- c(1, 0, abs(a[k])) v <- c(0, 1, abs(b[k])) while (v[3] != 0) { q <- floor(u[3]/v[3]) t <- u - v*q u <- v v <- t } e[k] <- u[1] * sign(a[k]) d[k] <- u[2] * sign(a[k]) g[k] <- u[3] } if (extended) { return(list(g = g, c = e, d = d)) } else { return(g) } } Lcm <- function(a, b) { stopifnot(is.numeric(a), is.numeric(b)) if (length(a) == 1) { a <- rep(a, times=length(b)) } else if (length(b) == 1) { b <- rep(b, times=length(a)) } g <- gcd(a, b, extended = FALSE) return( a / g * b ) } pracma/R/arclength.R0000644000176200001440000000210212660356064014013 0ustar liggesusers## ## a r c l e n g t h . R Arc Length ## arclength <- function(f, a, b, nmax = 20, tol = 1e-05, ...) { stopifnot(is.numeric(a), length(a) == 1, is.numeric(b), length(b) == 1) fun <- match.fun(f) f <- function(x) fun(x, ...) if (abs(b-a) < tol) return(list(length = 0, niter = 0, rel.err = tol)) fa <- f(a); fb <- f(b) m <- length(fa) if (length(fa) < 2) stop("Argument 'f' must be a parametrized function.") if (length(f(c(a, b))) != 2*m) stop("Argument 'f' must be a vectorized function.") h <- (b - a) A <- matrix(0, nmax, nmax) A[1, 1] <- sqrt(sum((fb - fa)^2)) for (i in 1:(nmax-1)) { h <- h/2 x <- seq(a, b, by = (b-a)/2^i) y <- c(f(x)) X <- matrix(y, ncol = m) dX <- diff(X) A[i+1, 1] <- sum(sqrt(rowSums(dX^2))) for (j in 1:i) { A[i+1, j+1] <- (4^j * A[i+1, j] - A[i, j]) / (4^j - 1) } if (abs(A[i+1, i+1] - A[i, i]) < tol && i > 3) break } e <- abs(A[i+1, i+1] - A[i, i]) list(length = A[i+1, i+1], niter = i+1, rel.err = e) } pracma/R/sind.R0000644000176200001440000000111212764776254013015 0ustar liggesusers## ## s i n e d . R Trigonometric Functions with degrees ## sind <- function(x) sinpi( x / 180 ) cosd <- function(x) cospi( x / 180 ) tand <- function(x) sinpi(x/180) / cospi(x/180) cotd <- function(x) 1 / tand(x) asind <- function(x) asin(x) * 180 / pi acosd <- function(x) acos(x) * 180 / pi atand <- function(x) atan(x) * 180 / pi acotd <- function(x) atand(1 / x) atan2d <- function(x1, x2) atan2(x1, x2) * 180 / pi secd <- function(x) 1 / cosd(x) cscd <- function(x) 1 / sind(x) asecd <- function(x) asec(x) * 180 / pi acscd <- function(x) acsc(x) * 180 / pi pracma/R/psi.R0000644000176200001440000001001512130550730012625 0ustar liggesusers## ## p s i . R Psi (Polygamma) Function ## psi <- function(k, z) { if (missing(z)) { z <- k; k <- 0 } stopifnot(is.numeric(z) || is.complex(z)) if (length(k) > 1 || k < 0) stop("Argument 'k': Invalid Polygamma order, or 'k' not a scalar.") k <- floor(k) sz <- dim(z) zz <- z <- c(z) f <- 0.0 * z if (k == 0) { # reflection point p <- which(Real(z) < 0.5) if (length(p) > 0) z[p] <- 1 - z[p] # Lanczos approximation for the complex plane g <- 607/128 # best results when 4 <= g <= 5 cc <- c(0.99999999999999709182, 57.156235665862923517, -59.597960355475491248, 14.136097974741747174, -0.49191381609762019978, 0.33994649984811888699e-4, 0.46523628927048575665e-4, -0.98374475304879564677e-4, 0.15808870322491248884e-3, -0.21026444172410488319e-3, 0.21743961811521264320e-3, -0.16431810653676389022e-3, 0.84418223983852743293e-4, -0.26190838401581408670e-4, 0.36899182659531622704e-5) n <- d <- 0 for (j in length(cc):2) { dz <- 1/(z+j-2) dd <- cc[j] * dz d <- d + dd n <- n - dd * dz } d <- d + cc[1] gg <- z + g - 0.5 # log is accurate to about 13 digits... f <- log(gg) + (n/d - g/gg) if (length(p) > 0) f[p] <- f[p] - pi*cot(pi*zz[p]) p <- which(round(zz) == zz && Real(zz) <= 0 && Imag(zz) == 0) if (length(p) > 0) f[p] <- Inf } else if (k > 0) { isneg <- which(Real(z) < 0) isok <- which(Real(z) >= 0) n <- k negmethod <- 1 if (length(isneg) > 0) { if (negmethod == 0) { zneg <- z[isneg] gneg <- psi(n, zneg+1) # recurse if to far to the left... hneg <- -(-1)^n * gamma(n+1) * zneg^(-(n+1)) fneg <- gneg + hneg } else { zneg <- z[isneg] # shift by, say, 500, to speed things up m <- 500 gneg <- psi(n, zneg+m) hneg <- 0 for (k in (m-1):0) hneg <- hneg + (zneg+k)^(-(n+1)) hneg <- -(-1)^n * gamma(n+1) * hneg fneg <- gneg + hneg } } if (length(isok) > 0) z <- z[isok] # the zeros of the Lanczos PFE series when g=607/128 are: r <- c(-4.1614709798720630 - 0.14578107125196249*1i, -4.1614709798720630 + 0.14578107125196249*1i, -4.3851935502539474 - 0.19149326909941256*1i, -4.3851935502539474 + 0.19149326909941256*1i, -4.0914355423005926, -5.0205261882982271, -5.9957952053472399, -7.0024851819328395, -7.9981186370233868, -9.0013449037361806, -9.9992157162305535,-11.0003314815563886, -11.9999115102434217,-13.0000110489923175587) # the poles of the Lanczos PFE series are: # p <- c(0, -1, -2, -3, -4, -5, -6, -7, -8, -9, -10, -11, -12, -13) e <- exp(1) g <- 607/128 # best results when 4<=g<=5 h <- 1/2 s <- 0 for (k in (length(r)-1):0) s <- s + (1/((z-r[k+1])^(n+1)) - 1/((z+k)^(n+1))) # what happens if n is not a positive integer? s <- (-1)^n * gamma(n+1) * s zgh <- z + (g-h) if (n == 0) { # s=log(zgh)+(-g./zgh + s); # use existing more accurate digamma function if n=0 # should never reach this code since we trapped it above f <- psi(z) } else { # do derivs of front end stuff s <- (-1)^(n+1) * (gamma(n) * zgh^(-n) + g*gamma(n+1) * zgh^-(n+1)) + s } if (length(isneg) > 0) f[isneg] <- fneg if (length(isok) > 0) f[isok] <- s } else stop("Argument 'k': Invalid Polygamma order.") if (is.numeric(z)) f <- Re(f) dim(f) <- sz return(f) } pracma/R/gradient.R0000644000176200001440000000432311572466165013655 0ustar liggesusers## ## g r a d i e n t . R Discrete Derivatives ## gradient <- function(F, h1 = 1, h2 = 1) { if (length(F) == 0 ) return(c()) if (!is.numeric(F)) stop("Argument 'F' must be a numeric vector or matrix.") if (length(h1) == 0 || length(h2) == 0 || (length(h1) == 1 && h1 == 0) || (length(h2) == 1 && h2 == 0)) stop("Arguments 'h1', 'h2' must be non-empty and non-zero.") if (any(diff(h1) == 0) || any(diff(h2) == 0)) stop("Arguments 'h1' and 'h2' must be strictly increasing.") if (is.vector(F)) { n <- length(F) if (n == 1) return(0) if (length(h1) == 1) { x <- seq(1*h1, n*h1, length.out = n) } else if (length(h1) == n) { x <- h1 } else stop("Length of 'h1' must be 1 or equal to length of 'F'.") g <- numeric(n) g[1] <- (F[2] - F[1]) / (x[2] - x[1]) g[n] <- (F[n] - F[n-1]) / (x[n] - x[n-1]) if (n > 2) g[2:(n-1)] <- (F[3:n] - F[1:(n-2)]) / (x[3:n] - x[1:(n-2)]) return(g) } else if (is.matrix(F)) { # stop("Two-dimensional version not yet implemented.") n <- nrow(F) m <- ncol(F) if (length(h1) == 1) { x <- seq(1*h1, m*h1, length.out = m) } else if (length(h1) == m) { x <- h1 } else stop("Length of 'h1' must be 1 or equal to ncol of 'F'.") if (length(h2) == 1) { y <- seq(1*h2, n*h2, length.out = n) } else if (length(h2) == n) { y <- h2 } else stop("Length of 'h2' must be 1 or equal to nrow of 'F'.") gX <- gY <- 0 * F # matrix(NA, nrow = n, ncol = m) gX[, 1] <- (F[, 2] - F[, 1]) / (x[2] - x[1]) gX[, m] <- (F[, m] - F[, m-1]) / (x[m] - x[m-1]) if (m > 2) gX[, 2:(m-1)] <- (F[, 3:m] - F[, 1:(m-2)]) / (x[3:m] - x[1:(m-2)]) gY[1, ] <- (F[2, ] - F[1, ]) / (y[2] - y[1]) gY[n, ] <- (F[n, ] - F[n-1, ]) / (y[n] - y[n-1]) if (n > 2) gY[2:(n-1), ] <- (F[3:n, ] - F[1:(n-2), ]) / (y[3:n] - y[1:(n-2)]) return(list(X = gX, Y = gY)) } else stop("Argument 'F' cannot be a higher-dimensional array.") } pracma/R/gamma.R0000644000176200001440000000555711561714424013144 0ustar liggesusers## ## g a m m a z . R ## gammaz <- function(z) { if (!is.numeric(z) && !is.complex(z)) stop("Argument 'z' must be a numeric or complex vector.") z <- c(z); zz <- z f <- complex(length(z)) p <- which(Re(z) < 0) if (length(p) > 0) z[p] <- -z[p] # Lanczos approximation g <- 607/128 cc <- c( 0.99999999999999709182, 57.156235665862923517, -59.597960355475491248, 14.136097974741747174, -0.49191381609762019978, 0.33994649984811888699e-4, 0.46523628927048575665e-4, -0.98374475304879564677e-4, 0.15808870322491248884e-3, -0.21026444172410488319e-3, 0.21743961811521264320e-3, -0.16431810653676389022e-3, 0.84418223983852743293e-4, -0.26190838401581408670e-4, 0.36899182659531622704e-5) z <- z - 1 zh <- z + 0.5 zgh <- zh + g # trick for avoiding FP overflow above z=141 zp <- zgh^(zh*0.5) ss <- 0.0 for (k in (length(cc)-1):1) ss <- ss + cc[k+1] / (z + k) # sqrt(2Pi) sq2pi <- 2.5066282746310005024157652848110; f <- (sq2pi * (cc[1]+ss)) * ((zp * exp(-zgh)) * zp); f[z == 0 | z == 1] <- 1.0 # adjust for negative real parts if (length(p) > 0) f[p] <- -pi/(zz[p] * f[p] * sin(pi*zz[p])) # adjust for negative poles p <- which(round(zz) == zz & Im(zz) == 0 & Re(zz) <= 0) if (length(p) > 0) f[p] <- Inf return(f) } # lgammaz <- function(z) { # if (!is.numeric(z) && !is.complex(z)) # stop("Argument 'z' must be a numeric or complex vector.") # # dimz <- dim(z) # z <- c(z) + 0i # zz <- z # f <- complex(length(z)) # # p <- which(Re(z) < 0) # if (length(p) > 0) z[p] <- -z[p] # # # Lanczos approximation # g <- 607/128 # # cc <- c( 0.99999999999999709182, 57.156235665862923517, # -59.597960355475491248, 14.136097974741747174, # -0.49191381609762019978, 0.33994649984811888699e-4, # 0.46523628927048575665e-4, -0.98374475304879564677e-4, # 0.15808870322491248884e-3, -0.21026444172410488319e-3, # 0.21743961811521264320e-3, -0.16431810653676389022e-3, # 0.84418223983852743293e-4, -0.26190838401581408670e-4, # 0.36899182659531622704e-5) # # s <- 0 # for (k in length(cc):2) # s <- s + cc[k]/(z + (k-2)) # # zg <- z + g - 0.5 # s2pi <- 0.9189385332046727417803297 # f <- (s2pi + log(cc[1]+s)) - zg + (z-0.5) * log(zg) # # f[z == 1 | z == 2] <- 0.0 # # if (length(p) > 0) { # lpi <- 1.14472988584940017414342735 + pi*1i # f[p] <- lpi - log(zz[p]) - f[p] - log(sin(pi*zz[p])) # } # # p <- which(round(zz) == zz & Im(zz) == 0 & Re(zz) <= 0) # if (length(p) > 0) # f[p] <- Inf # # dim(f) <- dimz # return(f) # } pracma/R/vander.R0000755000176200001440000000047311540452742013333 0ustar liggesusers### ### VANDER.R Vandermonde matrix ### vander <- function(x) { n <- length(x) if (n == 0) return(matrix(0, nrow=0, ncol=0)) if ((!is.numeric(x) && !is.complex(x)) || is.array(x)) stop("Argument 'x' must be a numeric or complex vector.") A <- outer(x, seq(n-1, 0), "^") return(A) } pracma/R/rmserr.R0000644000176200001440000000315211566455115013365 0ustar liggesusers## ## r m s e r r o r . R RMS Error ## rmserr <- function(x, y, summary = FALSE) { if (!is.numeric(x) || !is.numeric(y)) stop("Arguments 'x' and 'y' must be numeric vectors.") if (length(x) != length(y)) stop("Vectors 'x' and ' y' must have the same length.") n <- length(x); mae <- sum(abs(y - x))/n mae_f <- formatC(mae, digits=4, format="f") mse <- sum((y - x)^2)/n mse_f <- formatC(mse, digits=4, format="f") rmse <- sqrt(sum((y - x)^2)/n) rmse_f <- formatC(rmse, digits=4, format="f") mape <- sum( abs((y - x)/x) )/n mape_f <- formatC(mape, digits=4, format="f") nmse <- sum((y - x)^2)/sum((x - mean(x))^2) nmse_f <- formatC(nmse, digits=4, format="f") rstd <- sqrt(sum((y - x)^2)/n) / mean(x) rstd_f <- formatC(rstd, digits=4, format="f") if (summary) { cat("-- Error Terms --------------------------------------------------\n"); cat(" MAE: ", mae_f, " \t- mean absolute error (in range [", range(x), "])\n") cat(" MSE: ", mse_f, " \t- mean squared error (the variance?!)\n"); cat(" RMSE: ", rmse_f, " \t- root mean squared error (std. dev.)\n"); cat(" MAPE: ", mape_f, " \t- mean absolute percentage error\n"); cat(" LMSE: ", nmse_f, " \t- normalized mean squared error\n"); cat(" rSTD: ", rstd_f, " \t- relative standard deviation (", mean(x), ")\n"); cat("-----------------------------------------------------------------\n"); } R <- list(mae = mae, mse = mse, rmse = rmse, mape = mape, nmse = nmse, rstd = rstd) if (summary) { invisible(R) } else { return(R) } } pracma/R/linearproj.R0000644000176200001440000000335113403535607014216 0ustar liggesusers## ## l i n e a r p r o j . R Linear and affine projection ## linearproj <- function(A, B) { # Return the projection of points in the columns of B # onto the linear subspace spaned by the columns of A. stopifnot(is.numeric(A), is.numeric(B)) if (!is.matrix(A)) A <- as.matrix(A) if (!is.matrix(B)) B <- as.matrix(B) nA <- nrow(A); mA <- ncol(A) nB <- nrow(B); mB <- ncol(B) if (nA != nB) # dimension of R^n stop("Arguments 'A', 'B' must have the same number of rows.") if (Rank(A) < mA) stop("Matrix 'A' does not have maximal rank -- not a basis.") P <- qr.solve(t(A) %*% A, t(A) %*% B) Q <- A %*% P return(list(P = P, Q = Q)) } affineproj <- function(x0, C, b, unbound = TRUE, maxniter = 100) { if (unbound) { # Return projection of x0 onto the affine subspace # C x = b and the distance of x0 from this subspace. mC <- nrow(C); nC <- ncol(C) # n dimension, m codimension CC <- C %*% t(C) xp <- (diag(1, nC) - t(C) %*% qr.solve(CC, C)) %*% x0 + t(C) %*% qr.solve(CC, b) d <- Norm(xp) return(list(proj = xp, dist = d, niter = 0)) } else { # C fast projection method for enforcing equality and # positivity constraints: C x = b and x >= 0 svdC <- svd(C); x <- x0 svdmat <- svdC$v %*% diag(1/svdC$d, length(svdC$d)) %*% t(svdC$u) iterate <- TRUE; niter <- 0 while(iterate & niter <= maxniter) { niter <- niter + 1 bCx <- (b - c(C %*% x)) x <- x + c(svdmat %*% bCx) if (any(x < 0)) x[x < 0] <- 0 else iterate <- FALSE } d <- Norm(x0 - x) return(list(proj = x, dist = d, niter = niter)) } } pracma/R/lebesgue.R0000644000176200001440000000217411566702053013645 0ustar liggesusers## ## l e b e s g u e . R Lebesgue Coefficient ## lebesgue <- function(x, refine = 4, plotting = FALSE) { if (!is.numeric(x)) stop("Argument 'x' must be a numeric vector.") if (! refine %in% c(2,3,4,5,6,7,8,9,10)) stop("Argument 'refine' must be one of 2,3,4,5,6,7,8,9,10.") n <- length(x) N <- 2^refine * n + 1 X <- matrix(rep(x, times = n), nrow = n, ncol = n) # weights w <- 1 / apply(X - t(X) + diag(n), 1, prod) # refine grid points xp <- seq(min(x), max(x), length.out = N) xdiff <- matrix(rep(xp, times = n), n, N, byrow = TRUE) - matrix(rep(x, times = N), n, N) inds <- (xdiff == 0) lfun <- apply(xdiff, 2, prod) xdiff[inds] <- .Machine$double.eps # compute Lebesgue function Y <- abs((diag(w) %*% matrix(rep(lfun, times = n), n, N, byrow = TRUE)) / xdiff) lebfun <- apply(Y, 2, sum) if (plotting) { plot(xp, lebfun, type = "l", col = "blue", lty = 2, lwd = 2, xlab="Grid points", ylab="Coefficients", main = "Lebesgue Function") grid() } # return Lebesgue coefficient return(max(lebfun)) } pracma/R/gmres.R0000644000176200001440000000532612201120010013137 0ustar liggesusers## ## g m r e s . R Generalized Linear equation solver ## gmres <- function(A, b, x0 = rep(0, length(b)), errtol = 1e-6, kmax = length(b)+1, reorth = 1) { stopifnot(is.numeric(A), is.numeric(b), is.matrix(A)) b <- as.matrix(b) n <- length(b) if (nrow(A) != n || ncol(A) != n) stop("Matrix 'A' must be square and compatible with 'b'.") # initialization h <- zeros(kmax) v <- zeros(n, kmax) c <- zeros(kmax+1, 1) s <- zeros(kmax+1, 1) normF <- function(x) norm(as.matrix(x), type = 'F') x <- as.matrix(x0) if (norm(x, 'F') != 0) { r <- b - A %*% x } else { r <- b } rho <- norm(r, 'F') g <- rho*eye(kmax+1, 1) errtol <- errtol * norm(b, 'F') error <- c() # test for termination on entry error <- c(error, rho) niter <- 0 if(rho < errtol) return(list(x = x, error = error, niter = niter)) v[, 1] <- r/rho beta <- rho # GMRES iteration k <- 0 while (rho > errtol && k < kmax) { k <- k + 1 v[, k+1] <- A %*% v[, k] normav <- normF(v[, k+1]) # modified Gram-Schmidt for (j in 1:k) { h[j, k] <- t(v[, j]) %*% v[, k+1] v[, k+1] <- v[, k+1] - h[j,k] * v[, j] } h[k+1, k] <- normF(v[, k+1]) normav2 <- h[k+1, k] # reorthogonalize if ((reorth == 1 && normav + 0.001*normav2 == normav) || reorth == 3) { for (j in 1:k) { hr <- t(v[, j]) %*% v[, k+1] h[j, k] <- h[j, k] + hr v[, k+1] = v[, k+1] - hr*v[, j] } h[k+1, k] <- normF(v[, k+1]) } # watch out for happy breakdown if (h[k+1, k] != 0) v[, k+1] <- v[, k+1] / h[k+1, k] # form and store the information for the new Givens rotation if (k > 1) h[1:k, k] <- .givapp(c[1:(k-1)], s[1:(k-1)], h[1:k, k], k-1) nu <- normF(h[k:(k+1), k]) if (nu != 0) { c[k] <- Conj(h[k, k] / nu) s[k] <- -h[k+1, k] / nu h[k, k] <- c[k] * h[k, k] - s[k] * h[k+1, k] h[k+1, k] <- 0 g[k:(k+1)] <- .givapp(c[k], s[k], g[k:(k+1)], 1) } # update the residual norm rho <- abs(g[k+1]) error <- c(error,rho) } # at this point either k > kmax or rho < errtol y <- qr.solve(h[1:k, 1:k], g[1:k]) x <- x0 + v[1:n, 1:k] %*% y return(list(x = x, error = error, niter = k)) } .givapp <- function(c, s, v_in, k) { v_rot <- v_in for (i in 1:k) { w1 <- c[i] * v_rot[i] - s[i] * v_rot[i+1] w2 <- s[i] * v_rot[i] + Conj(c[i]) * v_rot[i+1] v_rot[i:(i+1)] <- c(w1, w2) } v_rot } pracma/R/fletcherpowell.R0000644000176200001440000000463613452637217015103 0ustar liggesusers## ## c g m i n . R Conjugate Gradient Minimization ## fletcher_powell <- function(x0, f, g = NULL, maxiter = 1000, tol = .Machine$double.eps^(2/3)) { eps <- .Machine$double.eps if (tol < eps) tol <- eps if (!is.numeric(maxiter) || length(maxiter) > 1 || maxiter < 1) stop("Argument 'maxiter' must be a positive integer.") maxiter <- floor(maxiter) if (! is.numeric(x0)) stop("Argument 'x0' must be a numeric vector.") n <- length(x0) if (n == 1) stop("Function 'f' is univariate; use some other optimization method.") # User provided or numerical gradient f <- match.fun(f) if (! is.null(g)) { g <- match.fun(g) } else { g <- function(x) grad(f, x) } x <- x0 # column vector? H <- diag(1, n, n) f0 <- f(x) g0 <- g(x) # row vector ! for (k in 1:maxiter) { s <- - H %*% as.matrix(g0) # downhill direction # Find minimal f(x + a*s) along the direction s f1 <- f0 z <- sqrt(sum(s^2)) if (z == 0) return(list(xmin = x, fmin = f1, ninter = k)) s <- c(s / z) a1 <- 0 a3 <- 1; f3 <- f(x + a3*s) while (f3 >= f1) { a3 <- a3/2; f3 <- f(x + a3*s) if (a3 < tol/2) return(list(xmin = x, fmin = f1, niter = k)) } a2 <- a3/2; f2 <- f(x + a2*s) h1 <- (f2 - f1)/a2 h2 <- (f3 -f2)/(a3 - a2) h3 <- (h2 - h1)/a3 a0 <- 0.5*(a2 - h1/h3); f0 <- f(x + a0*s) if (f0 < f3) a <- a0 else a <- a3 d <- a * s; dp <- as.matrix(d) xnew <- x + d fnew <- f(xnew) gnew <- g(xnew) y <- gnew - g0; yp <- as.matrix(y) A <- (dp %*% d) / sum(d * y) B <- (H %*% yp) %*% t(H %*% yp) / c(y %*% H %*% yp) Hnew <- H + A - B if (max(abs(d)) < tol) break # Prepare for next iteration H <- Hnew f0 <- fnew g0 <- gnew x <- xnew } if (k == maxiter) warning("Max. number of iterations reached -- may not converge.") return(list(xmin = x, fmin = f(x), niter = k)) } # alias -- deprecated # cgmin <- function(x0, f, g = NULL, # maxiter = 1000, tol = .Machine$double.eps^(2/3)) { # warning("Function 'cgmin' deprecated: use 'fletcher_powell' instead.") # fletcher_powell(x0, f, g, maxiter = maxiter, tol = tol) # } pracma/R/rat.R0000644000176200001440000000402712030302211012612 0ustar liggesusers## ## r a t . R Continuous Fractions ## .contfrac <- function(x, tol = 1e-6) { if (!is.numeric(x) || is.matrix(x)) stop("Argument 'x' must be a numeric scalar or vector.") if (length(x) > 1) { # Compute value of a continuous fraction n <- length(x) B <- diag(1, 2) for (i in seq(along=x)) { B <- B %*% matrix(c(x[i], 1, 1, 0), 2, 2) } return(B[1,1]/B[2,1]) } else { # Generate the continuous fraction of a value sgnx <- sign(x) x <- abs(x) b <- floor(x) k <- b r <- x - b B <- matrix(c(b, 1, 1, 0), 2, 2) while ( abs(x - B[1,1]/B[2,1]) > tol) { b <- floor(1/r) k <- c(k, b) r <- 1/r - b B <- B %*% matrix(c(b, 1, 1, 0), 2, 2) } return(list(cf = sgnx * k, rat = c(sgnx*B[1,1], B[2,1]), prec = abs(x - B[1,1]/B[2,1]))) } } rat <- function(x, tol = 1e-6) { if (length(x) == 0) return(c()) if (!is.numeric(x)) stop("Argument 'x' must be a numeric vector.") xs <- c(x) n <- length(xs) R <- character(n) for (i in 1:n) { x <- xs[i] k <- .contfrac(x, tol = tol)$cf if (length(k) >= 1) { cf <- paste("[ ", k[1], sep="") } if (length(k) >= 2) { cf <- paste(cf, "; ", k[2], sep="") } if (length(k) >= 3) { for (j in 3:length(k)) { cf <- paste(cf, ", ", k[j], sep="") } cf <- paste(cf, "]", sep="") } R[i] <- cf } return(R) } rats <- function(x, tol = 1e-6) { if (length(x) == 0) return(c()) if (!is.numeric(x)) stop("Argument 'x' must be a numeric vector.") xs <- c(x) n <- length(xs) R <- numeric(n) for (i in 1:n) { x <- xs[i] k <- .contfrac(x, tol = tol)$rat cf <- paste(k[1], "/", k[2], sep="") cat(cf, "\n") R[i] <- k[1]/k[2] } invisible(R) } pracma/R/polylog.R0000644000176200001440000000430111771635147013540 0ustar liggesusers## ## p o l y l o g . R ## polylog <- function(z, n) { stopifnot(is.numeric(z), is.numeric(n)) if (length(n) != 1 || floor(n) != ceiling(n) || n < -4) stop("Argument 'n' must be a natural number n >= -4 .") if (length(z) > 1 || abs(z) >= 1) stop("Argument 'z' must be a single real number with abs(z) < 1 .") b <- function(i) zeta_(n - i) S <- function(n, z, j) { out <- 0 for (k in 1:j) out <- out + z^k/k^n return(out) } eta_ <- function(x, j) { out <- 0 for (k in 1:j) out <- out + (-1)^(k+1) / k^x return(out) } zeta_ <- function(x) { prefactor <- 2^(x-1) / ( 2^(x-1)-1 ) numerator <- 1 + 36*2^x*eta_(x,2) + 315*3^x*eta_(x,3) + 1120*4^x*eta_(x,4) + 1890*5^x*eta_(x,5) + 1512*6^x*eta_(x,6) + 462*7^x*eta_(x,7) denominator <- 1 + 36*2^x + 315*3^x + 1120*4^x + 1890*5^x + 1512*6^x + 462*7^x return(prefactor * numerator / denominator) } alpha <- -log(z) if (abs(z) > 0.55) { preterm <- gamma(1-n)/alpha^(1-n) nominator <- b(0) - alpha * ( b(1) - 4*b(0)*b(4)/7/b(3) ) + alpha^2 * ( b(2)/2 + b(0)*b(4)/7/b(2) - 4*b(1)*b(4)/7/b(3) ) - alpha^3 * ( b(3)/6 - 2*b(0)*b(4)/105/b(1) + b(1)*b(4)/7/b(2) - 2*b(2)*b(4)/7/b(3) ) denominator <- 1 + alpha*4*b(4)/7/b(3) + alpha^2 * b(4) / 7 / b(2) + alpha^3 * 2 * b(4) / 105 / b(1) + alpha^4 * b(4) / 840 / b(0) y <- preterm + nominator / denominator } else { nominator <- 6435 * 9^n * S(n,z,8) - 27456 * 8^n * z*S(n,z,7) + 48048 * 7^n * z^2 * S(n,z,6) - 44352 * 6^n * z^3 * S(n,z,5) + 23100 * 5^n * z^4 * S(n,z,4) - 6720 * 4^n * z^5 * S(n,z,3) + 1008 * 3^n * z^6 *S(n,z,2) - 64 * 2^n * z^7 * S(n,z,1) denominator <- 6435 * 9^n - 27456 * 8^n * z + 48048 * 7^n * z^2 - 44352 * 6^n * z^3 + 23100 * 5^n * z^4 - 6720 * 4^n * z^5 + 1008 * 3^n * z^6 - 64 * 2^n * z^7 + z^8 y <- nominator / denominator } return(y) } pracma/R/distmat.R0000644000176200001440000000313012246372242013507 0ustar liggesusers## ## d i s t m a t . R Distance matrix and Hausdorff dimension ## # If a is m x r and b is n x r then # # apply(outer(a,t(b),"-"),c(1,4),function(x)sqrt(sum(diag(x*x)))) # # is the m x n matrix of distances between the m rows of a and # n rows of b. # # Modify, as necessary, if you want distances other than euclidean. # # The following code is 10-100 times faster. distmat <- function(X, Y) # Computes Euclidean distance between two vectors as: # ||A-B|| = sqrt ( ||A||^2 + ||B||^2 - 2*A.B ) # and vectorizes to rows in two matrices (or vectors). { if (!is.numeric(X) || !is.numeric(Y)) stop("X and Y must be numeric vectors or matrices.") if (is.vector(X)) dim(X) <- c(1,length(X)) if (is.vector(Y)) dim(Y) <- c(1,length(Y)) if (ncol(X) != ncol(Y)) stop("X and Y must have the same number of columns.") m <- nrow(X); n <- nrow(Y) XY <- X %*% t(Y) # (m,n)-matrix XX <- matrix( rep(apply(X*X, 1, sum), n), m, n, byrow=F ) YY <- matrix( rep(apply(Y*Y, 1, sum), m), m, n, byrow=T ) sqrt(pmax(XX + YY - 2*XY, 0)) } pdist <- function(X) { distmat(X, X) } pdist2 <- function(X, Y) { distmat(X, Y) } hausdorff_dist <- function(P, Q) { stopifnot(is.numeric(P), is.numeric(Q)) if (is.vector(P)) P <- matrix(P, ncol = 1) if (is.vector(Q)) Q <- matrix(Q, ncol = 1) if (ncol(P) != ncol(Q)) stop("'P' and 'Q' must have the same number of columns.") D <- distmat(P, Q) # directional Hausdorff dimension dhd_PQ <- max(apply(D, 1, min)) dhd_QP <- max(apply(D, 2, min)) return(max(dhd_PQ, dhd_QP)) } pracma/R/trace.R0000644000176200001440000000045012030661377013143 0ustar liggesusers## ## t r a c e . R Matrix trace ## Trace <- function(a) { if (length(a) <= 1) return(a) if ((!is.numeric(a) && !is.complex(a)) || !is.matrix(a)) stop("Argument 'a' must be a real or complex matrix.") if (nrow(a) != ncol(a)) stop("Matrix 'a' must be square.") return(sum(diag(a))) } pracma/R/quad.R0000644000176200001440000000335711600712273013002 0ustar liggesusers## ## q u a d . R Adaptive Simpson Quadrature ## quad <- function(f, xa, xb, tol = .Machine$double.eps^0.5, trace = FALSE, ...) { stopifnot(is.numeric(xa), length(xa) == 1, is.finite(xa), is.numeric(xb), length(xb) == 1, is.finite(xb)) fun <- match.fun(f) f <- function(x) fun(x, ...) if (xa == xb) return(xb-xa) else if (xa > xb) { tmp <- xa; xa <- xb; xb <- tmp rev_p <- TRUE } else rev_p <- FALSE eps <- .Machine$double.eps if (!is.finite(f(xa))) xa <- xa + 2*eps if (!is.finite(f(xb))) xb <- xb - 2*eps Q <- .adaptsim(f, xa, xb, tol, trace) if (rev_p) Q <- -1 * Q return(Q) } .adaptsim <- function(f, xa, xb, tol = tol, trace = trace) { x <- c(xa, (xa+xb)/2, xb) y <- c(f(xa), f((xa+xb)/2), f(xb)) fa <- y[1]; fm <- y[2]; fb <- y[3] yy <- f(xa + c(0.9501, 0.2311, 0.6068, 0.4860, 0.8913) * (xb-xa)) ab <- (xb - xa)/8 * (sum(y)+sum(yy)) if (ab == 0) ab <- xb-xa ab <- ab * tol/.Machine$double.eps Q <- .adaptsimstp(f, xa, xb, fa, fm, fb, ab, trace) return(Q) } .adaptsimstp <- function(f, xa, xb, fa, fm, fb, ab, trace) { m <- (xa + xb)/2 h <- (xb - xa)/4 x <- c(xa + h, xb - h) y <- c(f(xa + h), f(xb - h)) fml <- y[1]; fmr <- y[2] i1 <- h/1.5 * (fa + 4*fm + fb) i2 <- h/3 * (fa + 4*(fml + fmr) + 2*fm + fb) i1 <- (16*i2 - i1)/15 if ( (ab + (i1-i2) == ab) || (m <= xa) || (xb<=m) ) { if ( ((m <= xa) || (xb<=m))) warning("Required tolerance may not be met.") Q <- i1 if (trace) cat(xa, xb-xa, Q, "\n") } else { Q <- .adaptsimstp (f, xa, m, fa, fml, fm, ab, trace) + .adaptsimstp (f, m, xb, fm, fmr, fb, ab, trace) } return(Q) } pracma/R/simpadpt.R0000644000176200001440000000341711600712273013666 0ustar liggesusers## ## s i m p a d p t . R Adaptive Simpson's Rule ## simpadpt <- function(f, a, b, tol = 1e-6, ...) { stopifnot(is.numeric(a), length(a) == 1, is.numeric(b), length(b) == 1) eps <- .Machine$double.eps fun <- match.fun(f) f <- function(x) fun(x, ...) if (a == b) return(0) else if (a > b) return(-1 * simpadpt(f, b, a, tol = tol)) # Start with unequal subintervals h <- 1/8 * (b-a) x <- c(a, a+h, a+2*h, (a+b)/2, b-2*h, b-h, b) y <- c(f(a), f(a+h), f(a+2*h), f((a+b)/2), f(b-2*h), f(b-h), f(b)) # Avoid infinities at end points if ( !is.finite(y[1]) ) y[1] <- f(a + eps*(b-a)) if ( !is.finite(y[7]) ) y[7] <- f(b - eps*(b-a)) # Call the adaptive simpson function hmin <- eps * (b-a) / 1024 Q1 <- .simpadpt(f, x[1], x[3], y[1], y[2], y[3], tol, hmin) Q2 <- .simpadpt(f, x[3], x[5], y[3], y[4], y[5], tol, hmin) Q3 <- .simpadpt(f, x[5], x[7], y[5], y[6], y[7], tol, hmin) return(Q1 + Q2 + Q3) } .simpadpt <- function(f, a, b, fa, fc, fb, tol, hmin) { h <- b - a g <- (a + b)/2 # fc d <- (a + g)/2; fd <- f(d) e <- (g + b)/2; fe <- f(e) # Three- and five-point Simpson's rule # plus a one-step Romberg extrapolation Q1 <- (h/6) * (fa + 4*fc + fb) Q2 <- (h/12) * (fa + 4*fd + 2*fc + 4*fe + fb) Q <- Q2 + (Q2 - Q1)/15 if (!is.finite(Q)) { warning("Infinite or NA function value encountered.") return(Q) } else if (abs(Q2 - Q) <= tol) { return(Q) } else if (abs(h) < hmin || g == a || g == b) { warning("Minimum step size reached; singularity possible.") return(Q) } Q4 <- .simpadpt(f, a, g, fa, fd, fc, tol, hmin) Q5 <- .simpadpt(f, g, b, fc, fe, fb, tol, hmin) return(Q4 + Q5) } pracma/R/angle.R0000644000176200001440000000025712001565513013131 0ustar liggesusers## ## a n g l e . R ## Real <- function(z) Re(z) Imag <- function(z) Im(z) # Conj <- function(z) Conj(z) # use abs() for Mod() angle <- function(z) atan2(Im(z), Re(z)) pracma/R/errorbar.R0000644000176200001440000000335311670666606013701 0ustar liggesusers## ## e r r o r b a r . R Plot Error Bars ## #-- Plot or add horizontal and vertical error bars errorbar <- function(x, y, xerr = NULL, yerr = NULL, bar.col = "red", bar.len = 0.01, grid = TRUE, with = TRUE, add = FALSE, ...) { stopifnot(is.numeric(x), is.numeric(y)) if (!is.vector(x) || !is.vector(y) || length(x) != length(y)) stop("Arguments 'x' and 'y' must be numeric vectors of equal length.") n <- length(x) if ( !is.null(xerr) && (!is.vector(xerr) || (length(xerr) != n && length(xerr) != 1)) ) stop("Argument 'xerr' must be a vector the same length as 'x'.") if ( !is.null(yerr) && (!is.vector(yerr) || (length(yerr) != n && length(yerr) != 1)) ) stop("Argument 'yerr' must be a vector the same length as 'y'.") if (is.null(xerr)){ x1 <- min(x); x2 <- max(x) } else { x1 <- min(x - abs(xerr)) x2 <- max(x + abs(xerr)) } if (is.null(yerr)) { y1 <- min(y); y2 <- max(y) } else { y1 <- min(y - abs(yerr)) y2 <- max(y + abs(yerr)) } if (!add) { plot(x, y, xlim = c(x1, x2), ylim = c(y1, y2), ...) if (grid) grid() } # Plot the error bars if (!is.null(yerr)) segments(x, y-yerr, x, y+yerr, col = bar.col) if (!is.null(xerr)) segments(x-xerr, y, x+xerr, y, col = bar.col) if (with) { xd <- bar.len * (x2 - x1) / 2.0 yd <- bar.len * (y2 - y1) / 2.0 if (!is.null(yerr)) { segments(x-xd, y-yerr, x+xd, y-yerr, col = bar.col) segments(x-xd, y+yerr, x+xd, y+yerr, col = bar.col) } if (!is.null(xerr)) { segments(x-xerr, y-yd, x-xerr, y+yd, col = bar.col) segments(x+xerr, y-yd, x+xerr, y+yd, col = bar.col) } } invisible() } pracma/R/integral2.R0000644000176200001440000002267512250325322013740 0ustar liggesusers## ## i n t e g r a l 2 . R Double and Triple Integrals ## integral2 <- function(fun, xmin, xmax, ymin, ymax, sector = FALSE, reltol = 1e-6, abstol = 0, maxlist = 5000, singular = FALSE, vectorized = TRUE, ...) { stopifnot(is.numeric(xmin), length(xmin) == 1, is.numeric(xmax), length(xmax) == 1) if ( is.infinite(xmin) || is.infinite(xmax) || (!is.function(ymin) && is.infinite(ymin)) || (!is.function(ymax) && is.infinite(ymax)) ) stop("Borders of the integration domain cannot be infinite.") # check input parameters nlist <- floor(maxlist/10) # check function and vectorization fun <- match.fun(fun) if (sector) { # FUN <- function(theta, r) fun(r*cos(theta), r*sin(theta), ...) * r FUN <- function(x, y) fun(y*cos(x), y*sin(x), ...) * y } else { FUN <- function(x, y) fun(x, y, ...) } # check upper and lower bounds of y if (is.function(ymin)) { phiBvar <- ymin } else if (is.numeric(ymin)) { phiBvar <- function(x) ymin * ones(size(x)[1], size(x)[2]) } else stop("Argument 'ymin' must be a constant or a (vectorized) function.") if (is.function(ymax)) { phiTvar <- ymax } else if (is.numeric(ymax)) { phiTvar <- function(x) ymax * ones(size(x)[1], size(x)[2]) } else stop("Argument 'ymax' must be a constant or a (vectorized) function.") # check borders and redefine if (singular) { thetaL <- 0; thetaR <- pi phiB <- 0; phiT <- pi } else { thetaL <- xmin; thetaR <- xmax phiB <- 0; phiT <- 1 } area <- (thetaR - thetaL) * (phiT - phiB) # initial quadrature Qs <- .tensor(xmin, xmax, thetaL, thetaR, phiB, phiT, FUN, phiBvar, phiTvar, vectorized = vectorized, singular = singular) Qsub <- Qs$qsub; esub <- Qs$esub Q <- sum(Qsub) # some more parameters and main list eps <- .Machine$double.eps tol <- 100 * eps * abs(Q) err_ok <- 0 adjust <- 1 mainList <- zeros(nlist, 7) nList <- 0 # save info on rectangles in main list s2l <- .save2list(mainList, nList, Qsub, esub, thetaL, thetaR, phiB, phiT, tol, area, adjust, err_ok) mainList <- s2l$mlist nList <- s2l$nlist errbnd <- s2l$errbnd if (nList == 0 || errbnd <= tol) return(list(Q = Q, error = errbnd)) while (TRUE) { ne <- .nextEntry(mainList, nList) mainList <- ne$mlist nList <- ne$nlist temp <- ne$entry q <- temp[1]; e <- temp[2] thetaL <- temp[3]; thetaR <- temp[4] phiB <- temp[5]; phiT <- temp[6] # Approximate integral over four subrectangles Qs <- .tensor(xmin, xmax, thetaL, thetaR, phiB, phiT, FUN, phiBvar, phiTvar, vectorized = vectorized, singular = singular) Qsub <- Qs$qsub; esub <- Qs$esub newq <- sum(Qsub) adjust <- min(1, abs(q - newq)/e) Q <- Q + (newq - q) tol <- max(abstol, reltol * abs(Q)) / 8 tol <- max(tol, 100 * eps * abs(Q)) s2l <- .save2list(mainList, nlist, Qsub, esub, thetaL, thetaR, phiB, phiT, tol, area, adjust, err_ok) mainList <- s2l$mlist nList <- s2l$nlist errbnd <- s2l$errbnd if (nList == 0 || errbnd <= tol) { break } else if (nList > maxlist) { if (errbnd > max(abstol, max(100*eps, reltol) * abs(Q))) { stop("Maximum number of subintervals: w/o convergence.") } else { warning("Maximum number of subintervals: maybe low accuracy.") } break } } # accuracy or max. number of subdivisions rached return(list(Q = Q, error = errbnd)) } .tensor <- function(a, b, thetaL, thetaR, phiB, phiT, FUN, phiBvar, phiTvar, vectorized = vectorized, singular = singular) { # Gauss-Kronrod (3,7) pair with degrees of precision 5 and 11 nodes <- c( -0.9604912687080202, -0.7745966692414834, -0.4342437493468026, 0, 0.4342437493468026, 0.7745966692414834, 0.9604912687080202) nnodes <- length(nodes) onevec <- ones(2*nnodes,1) narray <- 0.25 * cbind(nodes, nodes) wt3 <- c(0, 5/9, 0, 8/9, 0, 5/9, 0) wt7 <- c(0.1046562260264672, 0.2684880898683334, 0.4013974147759622, 0.4509165386584744, 0.4013974147759622, 0.2684880898683334, 0.1046562260264672) Qsub <- zeros(4,1) esub <- zeros(4,1) dtheta <- thetaR - thetaL etheta <- thetaL + dtheta * c(0.25,0.75) theta <- c(dtheta*narray + rep(etheta, each = nnodes)) if (singular) { x <- 0.5*(b + a) + 0.5*(b - a)*cos(theta) } else { x <- theta } X <- onevec %*% x dphi <- phiT - phiB; ephi <- phiB + dphi * c(0.25,0.75) phi <- c(dphi*narray + rep(ephi, each = nnodes)) phi <- as.matrix(c(phi)) top <- phiTvar(x) bottom <- phiBvar(x) dydt <- top - bottom if (singular) { t <- 0.5 + 0.5*cos(phi) } else { t <- phi } Y <- onevec %*% bottom + t %*% dydt if (vectorized) { Z <- FUN(X, Y) } else { Z <- arrayfun(FUN, X, Y) } if (singular) { temp <- 0.25*(b - a) * sin(phi) %*% (dydt * sin(theta)) } else { temp <- onevec %*% dydt } Z <- Z * temp # Tensor product: Gauss 3 and 7 points formulae esub[1] <- wt3 %*% t(wt3 %*% Z[1:nnodes,1:nnodes]) esub[2] <- wt3 %*% t(wt3 %*% Z[1:nnodes,(nnodes+1):(2*nnodes)]) esub[3] <- wt3 %*% t(wt3 %*% Z[(nnodes+1):(2*nnodes),1:nnodes]) esub[4] <- wt3 %*% t(wt3 %*% Z[(nnodes+1):(2*nnodes),(nnodes+1):(2*nnodes)]) esub <- (esub/4)*(dtheta/2)*(dphi/2) Qsub[1] <- wt7 %*% t(wt7 %*% Z[1:nnodes,1:nnodes]) Qsub[2] <- wt7 %*% t(wt7 %*% Z[1:nnodes,(nnodes+1):(2*nnodes)]) Qsub[3] <- wt7 %*% t(wt7 %*% Z[(nnodes+1):(2*nnodes),1:nnodes]) Qsub[4] <- wt7 %*% t(wt7 %*% Z[(nnodes+1):(2*nnodes),(nnodes+1):(2*nnodes)]) Qsub <- (Qsub/4)*(dtheta/2)*(dphi/2); esub <- abs(esub - Qsub); return(list(qsub = Qsub, esub = esub)) } .save2list <- function(mainList, nList, Qsub, esub, thetaL, thetaR, phiB, phiT, tol, area, adjust, err_ok) { eps <- .Machine$double.eps dtheta <- thetaR - thetaL dphi <- phiT - phiB localtol <- tol * (dtheta/2) * (dphi/2) / area localtol <- max(localtol, 100*eps*abs(sum(Qsub))) adjerr <- adjust * esub if (nList+4 > size(mainList,1)) mainList <- rbind(mainList, zeros(100, 7)) if (adjerr[1] > localtol) { nList <- nList + 1 mainList[nList, ] <- c(Qsub[1], esub[1], thetaL, thetaL + dtheta/2, phiB ,phiB + dphi/2, adjerr[1]) } else { err_ok <- err_ok + adjerr[1] } if (adjerr[2] > localtol) { nList <- nList + 1 mainList[nList, ] <- c(Qsub[2], esub[2], thetaL + dtheta/2, thetaR, phiB, phiB + dphi/2, adjerr[2]) } else { err_ok <- err_ok + adjerr[2] } if (adjerr[3] > localtol) { nList <- nList + 1 mainList[nList, ] <- c(Qsub[3], esub[3], thetaL, thetaL + dtheta/2, phiB + dphi/2, phiT, adjerr[3]) } else { err_ok <- err_ok + adjerr[3] } if (adjerr[4] > localtol) { nList <- nList + 1 mainList[nList, ] <- c(Qsub[4], esub[4], thetaL + dtheta/2, thetaR, phiB + dphi/2, phiT, adjerr[4]) } else { err_ok <- err_ok + adjerr[4] } errbnd <- err_ok + sum(mainList[, 7]) return(list(mlist = mainList, nlist = nList, errbnd = errbnd)) } .nextEntry <- function(mainList, nList) { indx <- which.max(abs(mainList[1:nList, 7])) temp <- mainList[ indx, ] mainList <- mainList[-indx, ] nList <- nList - 1 return(list(mlist = mainList, nlist = nList, entry = temp)) } #-- -------------------------------------------------------------------------- integral3 <- function (fun, xmin, xmax, ymin, ymax, zmin, zmax, reltol = 1e-06, ...) { fct <- match.fun(fun) fun <- function(x, y, z) fct(x, y, z, ...) if (is.function(ymin)) { yBvar <- ymin } else if (is.numeric(ymin)) { yBvar <- function(x) rep(ymin, length(x)) } else { stop("Argument 'ymin' must be a constant or a function of x.") } if (is.function(ymax)) { yTvar <- ymax } else if (is.numeric(ymax)) { yTvar <- function(x) rep(ymax, length(x)) } else { stop("Argument 'ymax' must be a constant or a function of x.") } if (is.function(zmin)) {zBvar <- zmin } else if (is.numeric(zmin)) { zBvar <- function(x, y) rep(zmin, length(y)) } else { stop("Argument 'zmin' must be a constant or a function of x and y.") } if (is.function(zmax)) { zTvar <- zmax } else if (is.numeric(zmax)) { zTvar <- function(x, y) rep(zmax, length(y)) } else { stop("Argument 'zmax' must be a constant or a function of x and y.") } fx <- function(x) { z1 <- function(y) zBvar(x, y) z2 <- function(y) zTvar(x, y) fyz <- function(y, z) fun(x, y, z) integral2(fyz, yBvar(x), yTvar(x), z1, z2, reltol = reltol)$Q } f <- Vectorize(fx) integrate(f, xmin, xmax, subdivisions = 300L, rel.tol = reltol)$value } pracma/R/sqrtm.R0000644000176200001440000000331111662017543013212 0ustar liggesusers## ## s q r t m . R Matrix Square and p-th Roots ## sqrtm <- function(A, kmax = 20, tol = .Machine$double.eps^(1/2)) { stopifnot(is.numeric(A), is.matrix(A)) if (nrow(A) != ncol(A)) stop("Matrix 'A' must be square.") # should be "try(solve(A))" P0 <- A; Q0 <- diag(nrow(A)) k <- 0 # then k <- 1 while (norm(A - P0 %*% P0, 'F') > tol && k < kmax) { P1 <- 0.5 * (P0 + solve(Q0)) Q1 <- 0.5 * (Q0 + solve(P0)) P0 <- P1 Q0 <- Q1 k <- k + 1 } # k < 0 if iteration has not converged. if (k >= kmax) k <- -1 # return sqrtm(A) and sqrtm(A)^-1 return(list(B = P0, Binv = Q0, k = k, acc = norm(A - P0 %*% P0, 'F'))) } signm <- function(A, kmax = 20, tol = .Machine$double.eps^(1/2)) { A %*% sqrtm(A %*% A)$Binv } rootm <- function(A, p, kmax = 20, tol = .Machine$double.eps^(1/2)) { stopifnot(is.numeric(A), is.matrix(A)) if (nrow(A) != ncol(A)) stop("Matrix 'A' must be square.") n <- nrow(A) A0 <- A p0 <- p # err <- try(solve(A), silent = TRUE) # if (class(err == "try-error")) ... else ... if (p %% 2 == 1) { A <- A %*% A p <- 2*p } else { while (p %% 4 == 0) { A <- sqrtm(A)$B p <- p / 2 } } N <- N0 <- 1 acc <- Inf k <- 0 while (acc > tol && k < kmax) { # && acc <= accp N <- 2*N wN <- cos(2*pi/N) + 1i * sin(2*pi/N) # N-th root of unity # summing with roots of unity S <- solve(A)/4 for (j in 1:(N-1)) { B <- solve( A - ((1-wN^j)/(1+wN^j))^p * diag(n) ) S <- S + B * wN^j/(1+wN^j)^2 } S <- 2*p*sin(pi/p)/N * A %*% S S <- Re(S) Sp <- S for (j in 1:(p0-1)) Sp <- Sp %*% S acc <- norm(A0 - Sp, 'F') k <- k + 1 } # k < 0 if iteration has not converged. if (k >= kmax) k <- -1 return(list(B = S, k = k, acc = acc)) } pracma/R/hankel.R0000644000176200001440000000077512030655336013317 0ustar liggesusers## ## h a n k e l . R ## hankel <- function(a, b) { if (!is.vector(a)) stop("Argument 'a' must be a numeric or complex vector.") n <- length(a) if (missing(b)) b <- c(a[n], rep(0, n-1)) if (!is.vector(b)) stop("Argument 'b' must be a numeric or complex vector.") m <- length(b) if (a[n] != b[1]) warning("a[n] not equal to b[1], b[1] set to a[n].") H <- matrix(0, n, m) for (i in 2:(n+m)) H[row(H)+col(H) == i] <- if (i <= n+1) a[i-1] else b[i-n] return(H) } pracma/R/rosser.R0000644000176200001440000000112712030655336013362 0ustar liggesusers## ## r o s s e r . R ## rosser <- function() { matrix(c(611, 196, -192, 407, -8, -52, -49, 29, 196, 899, 113, -192, -71, -43, -8, -44, -192, 113, 899, 196, 61, 49, 8, 52, 407, -192, 196, 611, 8, 44, 59, -23, -8, -71, 61, 8, 411, -599, 208, 208, -52, -43, 49, 44, -599, 411, 208, 208, -49, -8, 8, 59, 208, 208, 99, -911, 29, -44, 52, -23, 208, 208, -911, 99), nrow=8, ncol=8) } pracma/R/curvefit.R0000644000176200001440000000171712056721661013704 0ustar liggesusers## ## c u r v e f i t . R Polynomial Curve Fit ## curvefit <- function(u, x, y, n, U = NULL, V = NULL) { stopifnot(is.numeric(u), is.numeric(x), is.numeric(y)) u <- c(u); m <- length(u) x <- as.matrix(c(x)); y <- as.matrix(c(y)) if (length(x) != m || length(y) != m) stop("Vectors 'x' and 'y' must have the same length as 't'.") if (!is.numeric(n) || length(n) != 1 || floor(n) != ceiling(n) || n < 1) stop("Argument 'n' must be an integer greater or equal 1.") Ax <- outer(u, seq(n, 0), "^") Ay <- outer(u, seq(n, 0), "^") if (is.null(U) || is.null(V)) { px <- lsqlin(Ax, x) py <- lsqlin(Ay, y) } else { Cx <- outer(U, seq(n, 0), "^"); cx <- V[, 1] Cy <- outer(U, seq(n, 0), "^"); cy <- V[, 2] px <- lsqlin(Ax, x, Cx, cx) py <- lsqlin(Ay, y, Cy, cy) } xp <- polyval(c(px), u) yp <- polyval(c(py), u) return(list(xp = xp, yp = yp, px = px, py = py)) } pracma/R/shubert.R0000755000176200001440000000247513233712754013537 0ustar liggesusers## ## s h u b e r t . R Shubert-Piyawskii Method ## shubert <- function(f, a, b, L, crit = 1e-04, nmax = 1000) { stopifnot(is.numeric(a), is.numeric(b), length(a) == 1, length(b) == 1) fun <- match.fun(f); f <- function(x) fun(x) nf <- 0 x0 <- (a + b)/2.0 y0 <- f(x0); nf <- nf + 1 xmax <- x0; ymax <- y0 fmax <- y0 + L*(b - a)/2.0 X <- numeric(nmax); Z <- numeric(nmax) X[1] <- b; Z[1] <- y0 + fmax X[2] <- a; Z[2] <- y0 + fmax n <- 2 while ((fmax - ymax) > crit && n < nmax) { xn <- X[n]; zn <- Z[n] yn <- f(xn); nf <- nf + 1 if (yn > ymax) { xmax <- xn; ymax <- yn } zL <- (zn + yn)/2.0; zR <- zL xL <- xn - (zn - yn)/2.0/L xR <- xn + (zn - yn)/2.0/L i1 <- 0; i2 <- 0 if (xL >= a && xL <= b) i1 <- 1 if (xR >= a && xR <= b) i2 <- 1 if (i1 == 1 && i2 == 0) { X[n] <- xL; Z[n] <- zL } else if (i1 == 0 && i2 == 1) { X[n] <- xR; Z[n] <- zR } else if (i1 == 1 && i2 == 1) { X[n] <- xL; Z[n] <- zL X[n+1] <- xR; Z[n+1] <- zR n <- n + 1 } Zo <- order(Z[1:n]) Z[1:n] <- Z[Zo]; X[1:n] <- X[Zo] fmax <- Z[n] } return(list(xopt = xmax, fopt = fmax, nopt = n)) }pracma/R/charpoly.R0000644000176200001440000000161111603653545013671 0ustar liggesuserscharpoly <- function(a, info = FALSE) { stopifnot(is.numeric(a), is.matrix(a)) n <- nrow(a); m <- ncol(a) if (n != m || n < 2) stop("Argument 'a' must be a square matrix.") if (n > 100) cat("The algorithm will be *very* slow for n > 100.\n") p <- rep(1, n+1) a1 <- a for (k in 2:n) { p[k] <- -1 * sum(diag(a1))/(k-1) if (k == n) a2 <- a1 a1 <- a %*% (a1 + p[k] * diag(1, n)) } p[n+1] <- -1 * sum(diag(a1))/n if (info) { adet <- (-1)^n * p[n+1] if (adet != 0) ainv <- -1 * (a2 + p[n] * diag(1, n))/p[n+1] else ainv = NaN # determine accuracy of the computation e <- a2 %*% a + p[n] *a - adet * diag(1, n) e <- max(abs(e)) cat("Error term:", e, "\n") } if (info) return(list(cp = p, det = adet, inv = ainv)) else return(p) } pracma/R/odregress.R0000644000176200001440000000143112221306445014034 0ustar liggesusers## ## o d r l i n r e g . R Orthogonal Distance Regression ## # Linear orthogonal distance regression method odregress <- function(x, y) { stopifnot(is.numeric(x), is.numeric(y)) Z <- cbind(x, y) n <- nrow(Z) # no. of data points m <- ncol(Z) - 1 # no. of independent variables meanZ <- repmat(apply(Z, 2, mean), n, 1) svdZ <- svd(Z - meanZ) V <- svdZ$v a <- -V[1:m, m+1] / V[m+1, m+1] b <- mean(Z %*% V[, m+1]) / V[m+1, m+1] # Fitted values yfit <- cbind(x, 1) %*% c(a, b) resd <- y - yfit # orthogonal distance normal <- V[, m+1] err <- abs((Z - meanZ) %*% normal) ssq <- sum(err^2) return( list(coeff = c(a, b), ssq = ssq, err = err, fitted = yfit, resid = resd, normal = normal) ) } pracma/R/find.R0000644000176200001440000000017712001565513012764 0ustar liggesusers## ## f i n d . R Finds indices of nonzero elements ## finds <- function(v) which( if (is.logical(v)) v else v != 0 ) pracma/R/str2num.R0000644000176200001440000000215012056073543013456 0ustar liggesusers## ## s t r 2 n u m . R ## str2num <- function(S) { s1 <- strTrim(S) ls <- nchar(s1) if (substr(s1, ls, ls) == ';') { s1 <- sub(';$', '', s1) prit <- FALSE } else { prit <- TRUE } s1 <- sub('^\\[', '', s1) s1 <- sub('\\]$', '', s1) s1 <- gsub(',', ' ', s1) s2 <- strsplit(s1, ';')[[1]] m <- length(s2) L1 <- scan(text=s2[1], quiet = TRUE) n <- length(L1) if (m > 1) { for (i in 2:m) { Li <- scan(text=s2[i], quiet = TRUE) if (n != length(Li)) stop("All rows in Argument 's' must have the same length.") L1 <- rbind(L1, Li) } } L2 <- unname(L1) if (any(is.na(L2)) || isempty(L2)) L2 <- c() if (prit) print(L2) invisible(L2) } num2str <- function(A, fmt = 3) { stopifnot(is.numeric(A), length(fmt) == 1) if (is.numeric(fmt)) fmt = paste("%.", round(fmt), "f", sep = '') dm <- dim(A) a1 <- sprintf(fmt, A) # a2 <- as.numeric(a1) if (!is.null(dm)) { dim(a1) <- dm # dim(a2) <- dm } return(a1) } pracma/R/interp2.R0000644000176200001440000000507311572466165013446 0ustar liggesusers## ## i n t e r p 2 . R 2-D Interpolation ## interp2 <- function(x, y, Z, xp, yp, method = c("linear", "nearest", "constant")) { stopifnot(is.numeric(x), is.numeric(y), is.numeric(Z), is.numeric(xp), is.numeric(yp), is.matrix(Z) ) lx <- length(x); ly <- length(y) if (ncol(Z) != lx || nrow(Z) != ly) stop("Required: 'length(x) = ncol(Z)' and 'length(y) = nrow(Z)'.") n <- length(xp) if (length(yp) != n) stop("Length of vectors 'xp' and 'yp' must be the same.") method <- match.arg(method) Z <- t(Z) # TODO: Exchange Z[x, y] with Z[y, x] instead! v <- numeric(n) xi <- findInterval(xp, x) yi <- findInterval(yp, y) i0 <- which(xp < min(x) | xp > max(x) | yp < min(y) | yp > max(y)) if (method == "linear") { for (k in 1:length(xp)) { if ( k %in% i0) { v[k] <- NA } else { i <- xi[k]; j <- yi[k] if (i == lx) i <- i-1 if (j == ly) j <- j-1 A <- matrix(c(1, x[i], y[j], x[i]*y[j], 1, x[i], y[j+1], x[i]*y[j+1], 1, x[i+1], y[j], x[i+1]*y[j], 1, x[i+1], y[j+1], x[i+1]*y[j+1]), nrow = 4, ncol = 4, byrow = TRUE) b <- Z[cbind(c(i,i,i+1,i+1), c(j,j+1,j,j+1))] v[k] <- sum(solve(A, b) * c(1, xp[k], yp[k], xp[k]*yp[k])) } } } else if (method == "constant") { for (k in 1:length(xp)) { if ( k %in% i0) { v[k] <- NA } else { v[k] <- Z[xi[k], yi[k]] } } } else if (method == "nearest") { for (k in 1:length(xp)) { if (k %in% i0) { v[k] <- NA } else { i <- xi[k] if (i == lx) i <- i-1 j <- yi[k] if (j == ly) j <- j-1 if (xp[k] <= (x[i] + x[i+1])/2) { if (yp[k] <= (y[j] + y[j+1])/2) { v[k] <- Z[i, j] } else { v[k] <- Z[i, j+1] } } else { if (yp[k] <= (y[j] + y[j+1])/2) { v[k] <- Z[i+1, j] } else { v[k] <- Z[i+1, j+1] } } } } } else stop("Method 'cubic' and others are not yet implemented.") return(v) } pracma/R/nthroot.R0000755000176200001440000000066511540452742013554 0ustar liggesusers### ### NTHROOT.R - Compute the real n-th root ### nthroot <- function(x, n) { if (! is.numeric(x)) stop("Argument 'x' must be numeric.") if (missing(n) || n <= 0 || ceiling(n) != floor(n)) stop("Argument 'n' must be a positive integer.") if (any(x[!is.na(x)] < 0) && n %% 2 == 0) stop("If argument 'x' is negative, 'n' must be an odd integer.") sx <- sign(x) return(sx * (sx * x)^(1/n)) } pracma/R/fzero.R0000644000176200001440000001455013575517725013214 0ustar liggesusers## ## f z e r o . R ## fzero <- function(fun, x, maxiter = 500, tol = 1e-12, ...) { if (!is.numeric(x) || length(x) > 2) stop("Argument 'x' must be a scalar or a vector of length 2.") err <- try(fun <- match.fun(fun), silent = TRUE) if(inherits(err, "try-error")) { stop("Argument function 'fun' not known in parent environment.") } else { f <- function(x) fun(x, ...) } zin <- NULL if (length(x) == 2) { if (x[1] <= x[2]) { a <- x[1]; b <- x[2] } else { warning("Left endpoint bigger than right one: exchanged points.") a <- x[2]; b <- x[1] } zin <- .zeroin(f, a, b, maxiter = maxiter, tol = tol) } else { # try to get b a <- x; fa <- f(a) if (fa == 0) return(list(x = a, fval = fa)) if (a == 0) { aa <- 1 } else { aa <- a } bb <- c(0.9*aa, 1.1*aa, aa-1, aa+1, 0.5*aa, 1.5*aa, -aa, 2*aa, -10*aa, 10*aa) for (b in bb) { fb <- f(b) if (fb == 0) return(list(x = b, fval = fb)) if (sign(fa) * sign(fb) < 0) { zin <- .zeroin(f, a, b, maxiter = maxiter, tol = tol) break } } } if (is.null(zin)) { warning("No interval w/ function 'f' changing sign was found.") return(list(x = NA, fval = NA)) } else { x1 <- zin$bra[1]; x2 <- zin$bra[2] f1 <- zin$ket[1]; f2 <- zin$ket[2] x0 <- sum(zin$bra)/2; f0 <- f(x0) if (f0 < f1 && f0 < f2) { return(list(x = x0, fval = f0)) } else if (f1 <= f2) { return(list(x = x1, fval = f1)) } else { return(list(x = x2, fval = f2)) } } } .zeroin <- function(f, a, b, maxiter = 100, tol = 1e-07) { stopifnot(is.numeric(a), is.numeric(b), length(a) == 1, length(b) == 1) mu <- 0.5 eps <- .Machine$double.eps info <- 0 ## Set up and prepare ... if (a > b) { tt <- a; a <- b; b <- tt } fa <- f(a); fb <- f(b) nfev <- 2 if (sign(fa) * sign(fb) > 0) stop("Function must differ in sign at interval endpoints.") itype <- 1 if (abs(fa) < abs(fb)) { u <- a; fu <- fa } else { u <- b; fu <- fb } d <- e <- u fd <- fe <- fu mba <- mu * (b - a) niter <- 0 while (niter < maxiter) { if (itype == 1) { # The initial test if ((b-a) <= 2*(2*abs(u)*eps + tol)) { x <- u; fval <- fu info <- 1 break } if (abs (fa) <= 1e3*abs(fb) && abs(fb) <= 1e3*abs(fa)) { # Secant step. c <- u - (a - b) / (fa - fb) * fu } else { # Bisection step. c <- 0.5 * (a + b) } d <- u; fd <- fu itype <- 5 } else if (itype == 2 || itype == 3) { l <- length(unique(c(fa, fb, fd, fe))) if (l == 4) { # Inverse cubic interpolation. q11 <- (d - e) * fd / (fe - fd) q21 <- (b - d) * fb / (fd - fb) q31 <- (a - b) * fa / (fb - fa) d21 <- (b - d) * fd / (fd - fb) d31 <- (a - b) * fb / (fb - fa) q22 <- (d21 - q11) * fb / (fe - fb) q32 <- (d31 - q21) * fa / (fd - fa) d32 <- (d31 - q21) * fd / (fd - fa) q33 <- (d32 - q22) * fa / (fe - fa) c <- a + q31 + q32 + q33; } if (l < 4 || sign(c - a) * sign(c - b) > 0) { # Quadratic interpolation + newton a0 <- fa a1 <- (fb - fa)/(b - a) a2 <- ((fd - fb)/(d - b) - a1) / (d - a) # Modification 1: this is simpler and does not seem to be worse. c <- a - a0/a1 if (a2 != 0) { c <- a - a0/a1 for (i in 1:itype) { pc <- a0 + (a1 + a2*(c - b))*(c - a) pdc <- a1 + a2*(2*c - a - b) if (pdc == 0) { c <- a - a0/a1 break } c <- c - pc/pdc } } } itype <- itype + 1 } else if (itype == 4) { # Double secant step. c <- u - 2*(b - a)/(fb - fa)*fu # Bisect if too far. if (abs (c - u) > 0.5*(b - a)) { c <- 0.5 * (b + a) } itype <- 5 } else if (itype == 5) { # Bisection step. c <- 0.5 * (b + a) itype <- 2 } # Don't let c come too close to a or b. delta <- 2 * 0.7 * (2 * abs(u) * eps + tol) if ((b - a) <= 2*delta) { c <- (a + b)/2 } else { c <- max(a + delta, min(b - delta, c)) } # Calculate new point. x <- c; fval <- fc <- f(c) niter <- niter + 1; nfev <- nfev + 1 # Mod2: skip inverse cubic interpolation if nonmonotonicity is detected. if (sign(fc - fa) * sign(fc - fb) >= 0) { ## The new point broke monotonicity. ## Disable inverse cubic. fe <- fc } else { e <- d; fe <- fd } # Bracketing. if (sign(fa) * sign(fc) < 0) { d <- b; fd <- fb b <- c; fb <- fc } else if (sign(fb) * sign(fc) < 0) { d <- a; fd <- fa a <- c; fa <- fc } else if (fc == 0) { a <- b <- c; fa <- fb <- fc info <- 1 break } else { # This should never happen. stop("zeroin: zero point could not be bracketed") } if (abs(fa) < abs(fb)) { u <- a; fu <- fa } else { u <- b; fu <- fb } if (b - a <= 2*(2 * abs (u) * eps + tol)) { info <- 1 break } # Skip bisection step if successful reduction. if (itype == 5 && (b - a) <= mba) { itype <- 2 } if (itype == 2) { mba <- mu * (b - a) } } # endwhile return(list(bra = c(a, b), ket = c(fa, fb), niter = niter, info = info)) } pracma/R/norm.R0000644000176200001440000000045512030661542013017 0ustar liggesusers## ## n o r m . R Vector Norm ## Norm <- function(x, p=2) { stopifnot(is.numeric(x) || is.complex(x), is.numeric(p), length(p) == 1) if (p > -Inf && p < Inf) sum(abs(x)^p)^(1/p) else if (p == Inf) max(abs(x)) else if (p == -Inf) min(abs(x)) else return(NULL) } pracma/R/neville.R0000755000176200001440000000351211605367045013512 0ustar liggesusers## ## ne v i l l e . R Neville and Newton Interpolation ## neville <- function(x, y, xs) { stopifnot(is.numeric(x), is.numeric(y)) if (!is.numeric(xs)) stop("Argument 'xs' must be empty or a numeric vector.") x <- c(x); y <- c(y) n <- length(x) if (length(y) != n) stop("Vectors 'x' and 'y' must be of the same length.") ys <- y for (k in 1:(n-1)) { y[1:(n-k)] <- ((xs - x[(k+1):n]) * y[1:(n-k)] + (x[1:(n-k)] - xs) * y[2:(n-k+1)]) / (x[1:(n-k)] - x[(k+1):n]) } ys <- y[1] return(ys) } newtonInterp <- function(x, y, xs = c()) { stopifnot(is.numeric(x), is.numeric(y)) if (length(xs) != 0 && !is.numeric(xs)) stop("Argument 'xs' must be empty or a numeric vector.") x <- c(x); y <- c(y) n <- length(x) if (length(y) != n) stop("Vectors 'x' and 'y' must be of the same length.") # Newton's polynomial interpolation formula p <- y for (k in 2:n) { p[k:n] <- (p[k:n] - p[k-1]) / (x[k:n] - x[k-1]) } if (length(xs) == 0) return(p) # Evaluating Newton's interpolation formula ys <- rep(p[n], length(xs)) for (k in 1:(n-1)) { ys <- p[n-k] + (xs - x[n-k]) * ys } return(ys) } lagrangeInterp <- function(x, y, xs) { stopifnot(is.numeric(x), is.numeric(y)) if (!is.numeric(xs)) stop("Argument 'xs' must be empty or a numeric vector.") x <- c(x); y <- c(y) n <- length(x) if (length(y) != n) stop("Vectors 'x' and 'y' must be of the same length.") A <- matrix(0, n, n) A[, 1] <- y for (i in 2:n) { A[i:n,i] <- (A[i:n, i-1] - A[i-1, i-1]) / (x[i:n]-x[i-1]) } ys <- A[n,n] * (xs - x[n-1]) + A[n-1,n-1] for (i in 2:(n-1)) { ys <- ys * (xs - x[n-i]) + A[n-i,n-i] } return(ys) } pracma/R/mexpfit.R0000644000176200001440000000476612072646270013540 0ustar liggesusers## ## m e x p f i t . R Multi-exponential Fitting ## mexpfit <- function(x, y, p0, w = NULL, const = TRUE, options = list()) { stopifnot(is.numeric(x), is.numeric(y), is.numeric(p0)) n <- length(x) if (length(y) != n) stop("Arguments 'x', 'y' must be of the same length.") p0 <- unique(p0) m <- length(p0) if (n <= 2*m+1) stop("Not enough data points available for fitting exponential sums.") opts <- list(tau = 1e-4, tolx = 1e-7, tolg = 1e-9, maxeval = 1000) namedOpts <- match.arg(names(options), choices = names(opts), several.ok = TRUE) if (!is.null(names(options))) opts[namedOpts] <- options if (any(p0 == 0) || any(duplicated(p0))) stop("All entries in 'p0' must be different and not equal to zero.") .fexp <- function(b) { M <- outer(x, b, function(x, b) exp(b*x)) if (const) M <- cbind(1, M) a <- qr.solve(M, y) M %*% a - y } Lsq <- lsqnonlin(.fexp, p0, options = opts) b <- Lsq$x M <- outer(x, b, function(x, b) exp(b*x)) if (const) M <- cbind(1, M) a <- qr.solve(M, y) if (const) { a0 <- a[1]; a <- a[-1] } else a0 <- 0 return(list(a0 = a0, a = a, b = b, ssq = Lsq$ssq, iter = Lsq$neval, errmess = Lsq$errmess)) } lsqsep <- function(flist, p0, xdata, ydata, const = TRUE) { stopifnot(is.numeric(xdata), is.numeric(ydata), is.numeric(p0)) n <- length(xdata) if (length(ydata) != n) stop("Numeric arguments 'xdata', 'ydata' must have the same length.") m <- length(flist) # lapply is.function .fapply <- function(b) { M <- matrix(1, nrow = n, ncol = m + 1) for (i in 1:m) { fi <- flist[[i]] xi <- fi(b[i], xdata) M[, i+1] <- xi } if (!const) M <- M[, 2:ncol(M)] a <- qr.solve(M, ydata) # sum((M %*% a - ydata)^2) M %*% a - ydata # for lsqnonlin } # Find the function parameters b Lsq <- lsqnonlin(.fapply, p0) b <- Lsq$x # Find the linear parameters a M <- matrix(1, nrow = n, ncol = m + 1) for (i in 1:m) { fi <- flist[[i]] xi <- fi(b[i], xdata) M[, i+1] <- xi } if (!const) M <- M[, 2:ncol(M)] a <- qr.solve(M, ydata) if (const) { a0 <- a[1]; a <- a[2:length(a)] } else { a0 <- 0 } return(list(a0 = a0, a = a, b = b, ssq = Lsq$ssq)) } pracma/R/trisolve.R0000644000176200001440000000233512337613220013712 0ustar liggesusers## ## t r i s o l v e . R Tridiagonal Linear System Solver ## trisolve <- function(a, b, d, rhs) { stopifnot(is.numeric(a), is.numeric(b), is.numeric(d), is.numeric(rhs)) n <- length(a) if (n < 3) stop("Argument 'n' must be greater or equal 3.") if (length(b) != n-1 || length(d) != n-1) stop("Vectors 'b' and 'd' must be of a length of length(a)-1.") if (length(rhs) != n) stop("Vector 'rhs' must be of the same length as 'a'.") else x <- rhs b <- c(b, 0) for (i in 1:(n-1)) { if (d[i] != 0) { t <- a[i]/d[i] si <- 1/sqrt(1+t*t) co <- t*si a[i] <- a[i]*co + d[i]*si h <- b[i] b[i] <- h*co + a[i+1]*si a[i+1] <- -h*si + a[i+1]*co d[i] <- b[i+1]*si b[i+1] <- b[i+1]*co h <- x[i] x[i] <- h*co + x[i+1]*si x[i+1] <- -h*si + x[i+1]*co } } if (any(a == 0.0)) stop("Triangular matrix is singular -- system not solvable.") x[n] <- x[n]/a[n] x[n-1] <- ( x[n-1] - b[n-1]*x[n] ) / a[n-1] for (i in (n-2):1) { x[i] <- ( x[i] - b[i]*x[i+1] - d[i]*x[i+2] ) / a[i] } return(x) } pracma/R/horner.R0000644000176200001440000000165211553266213013346 0ustar liggesusers## ## h o r n e r . R Horner Scheme ## # Horner's rule to compute p(x) and p'(x) vectorized for the # polynomial p = p_1*x^n + p_2*x^{n-1} + ... + p_n*x + p_{n+1} horner <- function(p, x) { if (length(p) == 0 || length(x) == 0) return(NULL) n <- length(p); m <- length(x) if (n == 0) { y <- dy <- rep(NA, m) } else if (n == 1) { y <- rep(p, m); dy <- rep(0, m) } else { y <- p[1]; dy <- 0 for (i in 2:n) { dy <- dy * x + y y <- y * x + p[i] } } return(list(y = y, dy = dy)) } # Deflated Horner scheme that returns p(x) and the polynomial q with # p(x) = q(x) * (x - x0) + r, r constant, and r = 0 if x0 is a root of p. hornerdefl <- function(p, x) { if (length(p) == 0 || length(x) == 0) return(NULL) n <- length(p) -1 # degree of polynomial q <- numeric(n+1) q[1] <- p[1] for (j in 2:(n+1)) q[j] <- p[j] + q[j-1]*x return(list(y = q[n+1], q = q[1:n])) } pracma/R/hessian.R0000644000176200001440000000237212160543703013500 0ustar liggesusers## ## h e s s i a n . R Hessian Matrix ## hessian <- function(f, x0, h = .Machine$double.eps^(1/4), ...) { if (!is.numeric(x0)) stop("Argument 'x0' must be a numeric vector.") fun <- match.fun(f) f <- function(x) fun(x, ...) n <- length(x0) if (length(f(x0)) != 1) stop("Function 'f' must be a univariate function of n variables.") if (n == 1) return(matrix(fderiv(f, x0, n = 2, h = h), nrow = 1, ncol = 1)) H <- matrix(NA, nrow = n, ncol = n) hh <- diag(h, n) for (i in 1:(n-1)) { hi <- hh[, i] H[i, i] <- (f(x0-hi) - 2*f(x0) + f(x0+hi)) / h^2 for (j in (i+1):n) { hj <- hh[, j] H[i, j] <- (f(x0+hi+hj) - f(x0+hi-hj) - f(x0-hi+hj) + f(x0-hi-hj)) / (4*h^2) H[j, i] <- H[i, j] } } hi <- hh[, n] H[n, n] <- (f(x0-hi) - 2*f(x0) + f(x0+hi)) / h^2 return(H) } laplacian <- function(f, x0, h = .Machine$double.eps^(1/4), ...) { if (!is.numeric(x0)) stop("Argument 'x0' must be a numeric vector.") fun <- match.fun(f) f <- function(x) fun(x, ...) n <- length(x0) hh <- rep(0, n) L <- 0 for (i in 1:n) { hh[i] <- h L <- L + (f(x0+hh) + f(x0-hh) - 2*f(x0)) / h^2 hh[i] <- 0 } return(L) } pracma/R/lsqlincon.R0000644000176200001440000000451713204365100014044 0ustar liggesusers## ## c o n s t r L s q l i n ## lsqlincon <- function(C, d, # min ||C x - d||_2 A = NULL, b = NULL, # A x <= b Aeq = NULL, beq = NULL, # Aeq x == beq lb = NULL, ub = NULL) # lb <= x <= ub { if (!requireNamespace("quadprog", quietly = TRUE)) { stop("quadprog needed for this function to work. Please install it.", call. = FALSE) } stopifnot(is.numeric(C), is.numeric(d)) if (is.null(A) && !is.null(b) || !is.null(A) && is.null(b)) stop("If any, both 'A' and 'b' must be NULL.") if (is.null(Aeq) && !is.null(beq) || !is.null(Aeq) && is.null(beq)) stop("If any, both 'Aeq' and 'beq' must be NULL.") if (!is.matrix(C)) C <- matrix(C, 1) mc <- nrow(C); nc <- ncol(C); n <- nc if (length(d) != mc) stop("Dimensions of 'C' and 'd' do not fit.") if (is.null(A) && is.null(Aeq) && is.null(lb) && is.null(ub)) return(qr.solve(C, d)) if (!is.null(A)) { if (!is.matrix(A)) A <- matrix(A, 1) ma <- nrow(A); na <- ncol(A) if (na != n) stop("Number of columns of 'A' does not fit with 'C'.") # ATTENTION: quadprog requires A x >= b ! A <- -A; b <- -b } if (is.null(Aeq)) { meq <- 0 } else { if (!is.matrix(Aeq)) Aeq <- matrix(Aeq, 1) meq <- nrow(Aeq); neq <- ncol(Aeq) if (neq != n) stop("Number of columns of 'Aeq' does not fit with 'C'.") } if (is.null(lb)) { diag_lb <- NULL } else { if (length(lb) == 1) { lb <- rep(lb, n) } else if (length(lb) != n) { stop("Length of 'lb' and dimensions of C do not fit.") } diag_lb <- diag(n) } if (is.null(ub)) { diag_ub <- NULL } else { if (length(ub) == 1) { ub <- rep(ub, n) } else if (length(ub) != n) { stop("Length of 'ub' and dimensions of C do not fit.") } # ATTENTION: quadprog requires -x >= -ub diag_ub <- -diag(n) ub <- -ub } Dmat <- t(C) %*% C dvec <- t(C) %*% d Amat <- rbind(Aeq, A, diag_lb, diag_ub) bvec <- c(beq, b, lb, ub) rslt <- quadprog::solve.QP(Dmat, dvec, t(Amat), bvec, meq=meq) rslt$solution } pracma/R/entropy.R0000755000176200001440000000311112745775605013562 0ustar liggesusers## ## e n t r o p y . R (Fast) Approximate Entropy ## approx_entropy <- function(ts, edim = 2, r = 0.2*sd(ts), elag = 1) { N <- length(ts) result <- numeric(2) for (j in 1:2) { m <- edim + j - 1 phi <- zeros(1, N-m+1) dataMat <- zeros(m, N-m+1) for (i in 1:m) dataMat[i, ] <- ts[i:(N-m+i)] for (i in 1:(N-m+1)) { tempMat <- abs(dataMat - repmat(dataMat[, i, drop = FALSE], 1, N-m+1)) boolMat <- apply(tempMat > r, 2, max) phi[i] <- sum(!boolMat)/(N-m+1) } result[j] <- sum(log(phi))/(N-m+1) } apen <- result[1] - result[2] return(apen) } sample_entropy <- function(ts, edim = 2, r = 0.2*sd(ts), tau = 1) { stopifnot(is.numeric(ts), is.numeric(edim)) if (tau > 1) { s <- seq(1, length(ts), by = tau) ts <- ts[s] } N <- length(ts) correl <- numeric(2) datamat <- zeros(edim + 1, N - edim) for (i in 1:(edim+1)) datamat[i, ] <- ts[i:(N - edim + i - 1)] for (m in edim:(edim+1)) { count <- zeros(1, N-edim) tempmat <- datamat[1:m, ] for (i in 1:(N-m-1)) { # calculate Chebyshev distance X <- abs(tempmat[, (i+1):(N-edim)] - repmat(tempmat[, i, drop=FALSE], 1, N-edim-i)) dst <- apply(X, 2, max) # calculate Heaviside function d <- (dst < r) count[i] <- sum(d) / (N - edim) } correl[m - edim + 1] <- sum(count) / (N - edim) } return(log(correl[1]/correl[2])) } pracma/R/arnoldi.R0000644000176200001440000000152313116316453013475 0ustar liggesusers## ## a r n o l d i . R Arnoldi Iteration ## arnoldi <- function(A, q, m) { stopifnot(is.numeric(A), is.numeric(q)) if (!is.matrix(A) || nrow(A) != nrow(A)) stop("Argument 'A' must be a square matrix") n <- nrow(A) q1 <- as.matrix(c(q)) if (length(q1) != n) stop("Argument 'q' must be a vector of length 'nrow(A)'.") if (missing(m)) m <- n q1 <- q1 / Norm(q1) Q <- zeros(n,m) Q[, 1] <- q1 H <- zeros(min(m+1,m), n) for (k in 1:m) { z <- A %*% Q[, k] for (i in 1:k) { H[i, k] <- t(Q[, i]) %*% z z <- z - H[i, k] * Q[, i] } if (k < n) { H[k+1, k] <- Norm(z) if (H[k+1, k] == 0) return(list(Q = Q, H = H)) Q[, k+1] <- z / H[k+1, k] } } return(list(Q = Q, H = H)) } pracma/R/semilog.R0000644000176200001440000000041312064403271013475 0ustar liggesusers## ## s e m i l o g . R ## semilogx <- function(x, y, ...) { plot(x, y, log = "x", ...) grid() } semilogy <- function(x, y, ...) { plot(x, y, log = "y", ...) grid() } loglog <- function(x, y, ...) { plot(x, y, log = "xy", ...) grid() } pracma/R/sorting.R0000644000176200001440000001214611552641253013536 0ustar liggesusers## ## s o r t i n g . R Sorting Routines ## .comp <- function(u, v) { # strictly increasing order if (u < v) TRUE else FALSE } bubbleSort <- function(a) { if (!is.numeric(a)) stop("Argument 'a' must be a non-empty numeric vector.") n <- length(a) if (n <= 1) return(a) for (i in 1:n) { for (j in 2:n) { b <- a[j] if (.comp(a[j], a[j-1]) ) { a[j] <- a[j-1] a[j-1] <- b } } } return(a) } insertionSort <- function(a) { if (!is.numeric(a)) stop("Argument 'a' must be a non-empty numeric vector.") n <- length(a) if (n <= 1) return(a) for (i in 2:n) { t <- a[i] j <- i while (j >=2 && a[j-1] > t) { a[j] <- a[j-1] j <- j-1 } a[j] <- t } return(a) } selectionSort <- function(a) { if (!is.numeric(a)) stop("Argument 'a' must be a non-empty numeric vector.") n <- length(a) if (n <= 1) return(a) for (i in 1:(n-1)) { min <- i for (j in (i+1):n) { if (a[j] < a[min]) min <- j } t <- a[min]; a[min] <- a[i]; a[i] <- t } return(a) } shellSort <- function(a, f = 2.3) { if (!is.numeric(a)) stop("Argument 'a' must be a non-empty numeric vector.") if (!is.numeric(f) || length(f) != 1 || f <= 1) stop("The retracting factor 'f' must be a numeric scalar > 1.0") n <- length(a) if (n <= 1) return(a) h <- n %/% 2 while ( h >= 1) { for (i in (h+1):n) { t <- a[i] j <- i while (a[j-h] > t) { a[j] <- a[j-h] j <- j - h if (j <= h) break } a[j] <- t } h <- round(h/f) } return(a) } heapSort <- function(a) { if (!is.numeric(a)) stop("Argument 'a' must be a non-empty numeric vector.") warning("Function 'heapSort' not yet implemented.") n <- length(a) if (n <= 1) return(a) return(a) } mergeSort <- function(a, m = 10) { stopifnot(is.numeric(m), length(m) == 1, floor(m) == ceiling(m)) if (!is.numeric(a)) stop("Argument 'a' must be a non-empty numeric vector.") n <- length(a) #if (n <= 1) return(a) if (n <= m) return(insertionSort(a)) m <- n %/% 2 left <- mergeSort(a[1:m]) right <- mergeSort(a[(m+1):n]) return(mergeOrdered(left, right)) } mergeOrdered <- function(a, b){ na <- length(a); nb <- length(b) ab <- numeric(na + nb) i <- j <- 1 repeat { if (a[i] <= b[j]) { ab[i+j-1] <- a[i] i <- i + 1 if (i > na) { ab[(i+j-1):(na+nb)] <- b[j:nb] break } } else { ab[i+j-1] <- b[j] j <- j + 1 if (j > nb) { ab[(i+j-1):(na+nb)] <- a[i:na] break } } } return(ab) } quickSort <- function(a, m = 3) { # m = 3..30 n <- length(a) if (n <= m) { return( insertionSort(a) ) } else { v <- (a[1]+a[2])/2 return ( c(quickSort(a[a <= v], m=m), quickSort(a[a > v], m=m))) } } quickSortx <- function(a, m = 25) { # m=20..40, m=25 is favoured n <- length(a) if (n <= m) return(insertionSort(a)) i <- 0; j <- n v <- a[n] repeat { while (i < n && a[i+1] < v) i <- i+1 while (j > 1 && a[j-1] >= v) j <- j-1 if (i >= j-1) break t <- a[i+1]; a[i+1] <- a[j-1]; a[j-1] <- t } if (i == 0) return( c(a[n], quickSortx(a[1:(n-1)])) ) if (j == n) return( c(quickSortx(a[1:(n-1)]), a[n]) ) return( c(quickSortx(a[1:i]), a[n], quickSortx(a[(i+1):(n-1)])) ) } is.sorted <- function(a) !is.unsorted(a) testSort <- function(n = 1000) { if (n >= 1e5) warning("n quite large: This will take some time!") x <- runif(n) cat("Test Begin...\n") cat("Do not test bubble sort (too slow).\n\n") # elapsed <- system.time(y <- bubbleSort(x))[3] # cat("Bubble sort: Elapsed time = ", elapsed, "\n") # if (is.sorted(y)) cat("Bubble sort successful.\n\n") # else cat("Bubble sort test FAILED.\n\n") # flush(stdout()) elapsed <- system.time(y <- insertionSort(x))[3] cat("Insertion sort: Elapsed time = ", elapsed, "secs\n") if (is.sorted(y)) cat("Insertion sort successful.\n\n") else cat("Insertion sort test FAILED.\n\n") flush(stdout()) elapsed <- system.time(y <- selectionSort(x))[3] cat("Selection sort: Elapsed time = ", elapsed, "secs\n") if (is.sorted(y)) cat("Selection sort successful.\n\n") else cat("Selection sort test FAILED.\n\n") flush(stdout()) elapsed <- system.time(y <- shellSort(x))[3] cat("Shellsort: Elapsed time = ", elapsed, "secs\n") if (is.sorted(y)) { cat("Shell sort successful.\n\n") } else { cat("Shell sort test FAILED.\n\n") } flush(stdout()) elapsed <- system.time(y <- mergeSort(x))[3] cat("Mergesort: Elapsed time = ", elapsed, "secs\n") if (is.sorted(y)) { cat("Merge sort successful.\n\n") } else { cat("Merge sort test FAILED.\n\n") } flush(stdout()) elapsed <- system.time(y <- heapSort(x))[3] cat("Heapsort: Elapsed time = ", elapsed, "secs\n") if (is.sorted(y)) { cat("heap sort successful.\n\n") } else { cat("Heap sort test FAILED.\n\n") } flush(stdout()) elapsed <- system.time(y <- quickSort(x))[3] cat("Quicksort: Elapsed time = ", elapsed, "secs\n") if (is.sorted(y)) { cat("Quicksort successful.\n\n") } else { cat("Quicksort test FAILED.\n\n") } cat("Test End\n") } #-- HwB (C) 2010 ------------------------------------------------------- pracma/R/segment.R0000644000176200001440000000463111565176163013522 0ustar liggesusers## ## s e g m e n t . R Segment Functions ## segm_intersect <- function(s1, s2) { stopifnot(is.numeric(s1), nrow(s1) == 2, ncol(s1) == 2, is.numeric(s2), nrow(s2) == 2, ncol(s2) == 2) bb <- function(s) { # bounding box coordinates matrix(c(min(s[,1]), max(s[,1]), min(s[,2]), max(s[,2])), 2, 2) } # compute bounding boxes bb1 <- bb(s1) bb2 <- bb(s2) # bounding boxes do not intersect if (! all(rbind(bb1[2,], bb2[2,]) >= rbind(bb2[1,], bb1[1,])) ) return(FALSE) # bounding boxes are intersecting p1 <- s1[1,]; p2 <- s1[2,] p3 <- s2[1,]; p4 <- s2[2,] sgn1 <- sign(cross(c(p3-p1, 0), c(p2-p1, 0))[3]) * sign(cross(c(p4-p1, 0), c(p2-p1, 0))[3]) sgn2 <- sign(cross(c(p1-p3, 0), c(p4-p3, 0))[3]) * sign(cross(c(p2-p3, 0), c(p4-p3, 0))[3]) if (sgn1 <= 0 && sgn2 <= 0) TRUE else FALSE } segm_distance <- function(p1, p2, p3, p4 = c()) { stopifnot(is.numeric(p1), is.numeric(p2), is.numeric(p3), length(p1) == 2, length(p2) == 2, length(p3) == 2) edist <- function(p1, p2) sqrt((p1[1]-p2[1])^2 + (p1[2]-p2[2])^2) if (is.null(p4)) { if (edist(p1, p2) == 0) return(list(d = edist(p1, p3), p = p1)) p21 <- p2 - p1 # det(A) = 0 only if p1 = p2 A <- matrix(c(-p21[2], -p21[1], p21[1], -p21[2]), 2, 2, byrow=TRUE) b <- as.matrix(p1 - p3) a <- solve(A, b)[2] # crossing point at p1 + a*(p2-p1) if (a >= 0 && a <= 1) p <- p1 + a*(p2-p1) else if (a < 0) p <- p1 else p <- p2 return(list(d = edist(p, p3), p = p, q = p3)) } else if (is.numeric(p4) && length(p4) == 2) { if (segm_intersect(rbind(p1, p2), rbind(p3, p4)) && cross(c(p2-p1, 0), c(p4-p3, 0))[3] != 0) { A <- cbind(p2 - p1, p4 - p3) b <- (p3 - p1) a <- solve(A, b) return(list(d = 0, p = p1+a[1]*(p2-p1), q = p3-a[2]*(p4-p3))) } else { P <- list(p3, p4, p1, p2) S <- list(segm_distance(p1, p2, p3), segm_distance(p1, p2, p4), segm_distance(p3, p4, p1), segm_distance(p3, p4, p2)) i <- which.min(lapply(S, function(s) s$d)) return(list(d = S[[i]]$d, p = S[[i]]$p, q = P[[i]])) } } else stop("Argument 'p4' must be NULL or a vector of length 2.") } pracma/R/tictoc.R0000644000176200001440000000126112054177676013345 0ustar liggesusers### ### TICTOC.R - Stopwatch timer ### ##----------------------------------------------------------------------------- tic <- function(gcFirst = FALSE) { if (gcFirst == TRUE) { gc(verbose = FALSE) } assign("elapsedTime", proc.time()[3], envir = .pracmaEnv) invisible() } ##----------------------------------------------------------------------------- toc <- function(echo = TRUE) { prevTime <- get("elapsedTime", envir = .pracmaEnv) diffTimeSecs <- proc.time()[3] - prevTime if (echo) { cat(sprintf("elapsed time is %f seconds", diffTimeSecs), "\n") return(invisible(diffTimeSecs)) } else { return(diffTimeSecs) } } pracma/R/itersolve.R0000644000176200001440000000301612105737273014064 0ustar liggesusers## ## i t e r s o l v e . R Iterative Solutions of LSEs ## itersolve <- function(A, b, x0 = NULL, nmax = 1000, tol = .Machine$double.eps^(0.5), method = c("Gauss-Seidel", "Jacobi", "Richardson")) { stopifnot(is.numeric(A), is.numeric(b)) n <- nrow(A) if (ncol(A) != n) stop("Argument 'A' must be a square, positive definite matrix.") b <- c(b) if (length(b) != n) stop("Argument 'b' must have the length 'n = ncol(A) = nrow(A).") if (is.null(x0)) { x0 <- rep(0, n) } else { stopifnot(is.numeric(x0)) x0 <- c(x0) if (length(x0) != n) stop("Argument 'x0' must have the length 'n=ncol(A)=nrow(A).") } method <- match.arg(method) if (method == "Jacobi") { L <- diag(diag(A)) U <- eye(n) beta <- 1; alpha <- 1 } else if (method == "Gauss-Seidel") { L <- tril(A) U <- eye(n) beta <- 1; alpha <- 1 } else { # method = "Richardson" L <- eye(n) U <- L beta <- 0 } b <- as.matrix(b) x <- x0 <- as.matrix(x0) r <- b - A %*% x0 r0 <- err <- norm(r, "f") iter <- 0 while (err > tol && iter < nmax) { iter <- iter + 1 z <- qr.solve(L, r) z <- qr.solve(U, z) if (beta == 0) alpha <- drop(t(z) %*% r/(t(z) %*% A %*% z)) x <- x + alpha * z r <- b - A %*% x err <- norm(r, "f") / r0 } return(list(x = c(x), iter = iter, method = method)) } pracma/R/euler_heun.R0000644000176200001440000000131512425377750014210 0ustar liggesusers## ## e u l e r H e u n . R Euler-Heun ODE Solver ## euler_heun <- function(f, a, b, y0, n = 100, improved = TRUE, ...) { stopifnot(is.numeric(a), is.numeric(b), length(a) == 1, length(b) == 1, is.numeric(y0), length(y0) == 1) fun <- match.fun(f) f <- function(t, y) fun(t, y, ...) if (length(f(a, y0)) != 1) stop("Argument function 'f' must be an univariate function.") h <- (b - a)/n t <- seq(a, b, length.out = n+1) y <- numeric(n+1) y[1] <- y0 for (i in 1:n) { y[i+1] <- y[i] + h*f(t[i], y[i]) if (improved) { y[i+1] <- y[i] + h * (f(t[i], y[i]) + f(t[i+1], y[i+1]))/2.0 } } return(list(t = t, y = y)) } pracma/R/mldivide.R0000644000176200001440000000146312162042552013641 0ustar liggesusers## ## m l d i v i d e . R Matlab backslash Operator ## mldivide <- function(A, B, pinv = TRUE) { stopifnot(is.numeric(A) || is.complex(A), is.numeric(B) || is.complex(B)) if (is.vector(A)) A <- as.matrix(A) if (is.vector(B)) B <- as.matrix(B) if (nrow(A) != nrow(B)) stop("Matrices 'A' and 'B' must have the same number of rows.") if (pinv) { pinv(t(A) %*% A) %*% t(A) %*% B } else { qr.solve(A, B) } } mrdivide <- function(A, B, pinv = TRUE) { stopifnot(is.numeric(A) || is.complex(A), is.numeric(B) || is.complex(B)) if (is.vector(A)) A <- t(A) if (is.vector(B)) B <- t(B) if (ncol(A) != ncol(B)) stop("Matrices 'A' and 'B' must have the same number of columns.") t(mldivide(t(B), t(A), pinv = pinv)) } pracma/R/barycentric.R0000644000176200001440000000414611573217156014363 0ustar liggesusers## ## b a r y c e n t r i c . R Barycentric Lagrange Interpolation ## barylag <- function(xi, yi, x) { stopifnot(is.vector(xi, mode="numeric"), is.vector(xi, mode="numeric")) if (!is.numeric(x)) stop("Argument 'x' must be a numeric vector or matrix.") n <- length(xi); m <- length(x) # Check the input arguments if (length(yi) != n) stop("Node vectors xi an yi must be of same length.") if ( min(x) < min(xi) || max(x) > max(xi) ) stop("Some interpolation points outside the nodes.") # Compute weights X <- matrix(rep(xi, times=n), n, n) wi <- 1 / apply(X - t(X) + diag(1, n, n), 1, prod) # Distances between nodes and interpolation points Y <- outer(x, xi, "-") # Identify interpolation points that are nodes inds <- which(Y == 0, arr.ind=TRUE) Y[inds] <- NA # Compute the values of interpolated points W <- matrix(rep(wi, each=m), m, n) / Y y <- (W %*% yi) / apply(W, 1, sum) # Replace with values at corresponding nodes y[inds[,1]] <- yi[inds[,2]] # Return interpolation values as vector return(y[,]) } barylag2d <- function(F, xn, yn, xf, yf) { M <- nrow(F); N <- ncol(F) Mf <- length(xf); Nf <- length(yf) # Compute weights X <- matrix(xn, M, 1) %x% matrix(1, 1, M) # Kronecker product Y <- matrix(yn, N, 1) %x% matrix(1, 1, N) Wx <- t(1 / apply(X - t(X) + diag(1, M, M), 1, prod)) %x% matrix(1, Mf, 1) Wy <- t(1 / apply(Y - t(Y) + diag(1, N, N), 1, prod)) %x% matrix(1, Nf, 1) # Distances between nodes and interpolation points xdist <- matrix(xf, Mf, 1) %x% matrix(1, 1, M) - matrix(xn, 1, M) %x% matrix(1, Mf, 1) ydist <- matrix(yf, Nf, 1) %x% matrix(1, 1, N) - matrix(yn, 1, N) %x% matrix(1, Nf, 1) # Identify interpolation points that are nodes eps <- .Machine$double.eps xdist[xdist == 0] <- eps ydist[ydist == 0] <- eps # Thanks to Greg von Winckel for this trick ! Hx <- Wx / xdist Hy <- Wy / ydist Hx %*% F %*% t(Hy) / ( (matrix(apply(Hx, 1, sum), Mf, 1) %x% matrix(1, 1, Nf)) * (matrix(apply(Hy, 1, sum), 1, Nf) %x% matrix(1, Mf, 1)) ) } pracma/R/isposdef.R0000644000176200001440000000075513575517725013705 0ustar liggesusersisposdef <- function(A, psd = FALSE, tol = 1e-10) { if (nrow(A) != ncol(A)) { warning("Matrix 'A' is not quadratic.\n", .call = FALSE) a <- FALSE } else if (any(abs(A - t(A)) > tol)) { warning("Matrix 'A' is not symmetric.\n", .call = FALSE) a <- FALSE } else { e <- try(chol(A, pivot = psd), silent = TRUE) if(inherits(e, "try-error")) { a <- FALSE } else { a <- TRUE } } return(a) } pracma/R/tri.R0000644000176200001440000000255412122054210012632 0ustar liggesusers## ## t r i . R Triangular matrices ## tril <- function(M, k = 0) { if (k == 0) { M[upper.tri(M, diag = FALSE)] <- 0 } else { M[col(M) >= row(M) + k + 1] <- 0 } return(M) } triu <- function(M, k = 0) { if (k == 0) { M[lower.tri(M, diag = FALSE)] <- 0 } else { M[col(M) <= row(M) + k - 1] <- 0 } return(M) } ## Format distance matrix squareform <- function(x) { stopifnot(is.numeric(x) || is.complex(x)) if (is.vector(x)) { n <- length(x) m <- floor(sqrt(2*n)) if (m*(m+1) != 2*n) stop("Argument 'x' does not correspond to a distance matrix.") inds <- c() k <- m+1 for (i in 1:(k-1)) inds <- c(inds, (1+i+(i-1)*k):(i*k)) y <- numeric(k*k) y[inds] <- x y <- matrix(y, k, k) + t(matrix(y, k, k)) } else if (is.matrix(x)) { m <- nrow(x); n <- ncol(x) if (m != n) stop("Argument 'x' must be a vector or a square matrix.") if (any(diag(x) != 0)) stop("Argument 'x' can only have 0s on the diagonal.") if (n == 1) return(c()) inds <- c() for (i in 1:(n-1)) inds <- c(inds, (1+i+(i-1)*n):(i*n)) y <- x[inds] } else stop("Argument 'x' must be a numeric or complex vector or matrix.") return(y) } pracma/R/rkf54.R0000644000176200001440000000462111605036021012771 0ustar liggesusers## ## r k f 5 4 . R Runge-Kutta-Fehlberg ## rkf54 <- function(f, a, b, y0, tol = .Machine$double.eps^0.5, control = list(), ...) { stopifnot(is.numeric(a), length(a) == 1, is.numeric(b), length(b) == 1) if (tol < .Machine$double.eps) tol <- .Machine$double.eps # control list handling cntrl <- list(hmin = 0.001, hmax = 0.250, jmax = 200) nmsCo <- match.arg(names(control), choices = names(cntrl), several.ok = TRUE) if (!is.null(names(control))) cntrl[nmsCo] <- control fun <- match.fun(f) f <- function(x, y) fun(x, y, ...) # coefficient matrices a2 <- 1/4; b2 <- 1/4 a3 <- 3/8; b3 <- 3/32; c3 <- 9/32 a4 <- 12/13; b4 <- 1932/2197; c4 <- -7200/2197; d4 <- 7296/2197 a5 <- 1; b5 <- 439/216; c5 <- -8; d5 <- 3680/513; e5 <- -845/4104 a6 <- 1/2; b6 <- -8/27; c6 <- 2; d6 <- -3544/2565; e6 <- 1859/4104; f6 <- -11/40 r1 <- 1/360; r3 <- -128/4275; r4 <- -2197/75240; r5 <- 1/50; r6 <- 2/55 n1 <- 25/216; n3 <- 1408/2565; n4 <- 2197/4104; n5 <- -1/5 # Initialize solution vectors j <- 1 T <- c(a) Y <- c(y0) # Initialize control parameters hmin <- cntrl$hmin hmax <- cntrl$hmax jmax <- cntrl$jmax h <- 0.8*hmin + 0.2*hmax br <- b - tol * abs(b) while (T[j] < b) { if (T[j] + h > br) h <- b - T[j] tj <- T[j]; yj <- Y[j] k1 <- h * f(tj, yj) k2 <- h * f(tj + a2*h, yj + b2*k1) k3 <- h * f(tj + a3*h, yj + b3*k1 + c3*k2) k4 <- h * f(tj + a4*h, yj + b4*k1 + c4*k2 + d4*k3) k5 <- h * f(tj + a5*h, yj + b5*k1 + c5*k2 + d5*k3 + e5*k4) k6 <- h * f(tj + a6*h, yj + b6*k1 + c6*k2 + d6*k3 + e6*k4 + f6*k5) err <- abs(r1*k1 + r3*k3 + r4*k4 + r5*k5 + r6*k6) ynew <- yj + n1*k1 + n3*k3 + n4*k4 + n5*k5 # Convergence condition if (err < tol || h < 2*hmin) { Y <- c(Y, ynew) if (tj + h > br) T <- c(T, b) else T <- c(T, tj + h) j <- j+1; } # Compute next step length if (err == 0) s <- 0 else s <- s <- (tol*h/(2*err))^0.25 if (s < 0.1) s <- 0.1 if (s > 4.0) s <- 4.0 h <- s * h if (h > hmax) h <- hmax if (h < hmin) h <- hmin if (j >= jmax) { warning(paste("Maximum number of steps reached:", j)) break } } return(list(x = T, y = Y)) } pracma/R/rref.R0000644000176200001440000000201312322500221012760 0ustar liggesusers## ## r r e f . R Reduced Row Echelon Form ## rref <- function(A) { stopifnot(is.numeric(A)) if (!is.matrix(A)) stop("Input parameter 'A' must be a matrix.") nr <- nrow(A); nc <- ncol(A) tol <- eps() * max(nr, nc) * max(abs(A)) r <- 1 for (i in 1:nc) { pivot <- which.max(abs(A[r:nr, i])) pivot <- r + pivot - 1 m <- abs(A[pivot, i]) if (m <= tol) { A[r:nr, i] <- 0 # zeros(nr-r+1, 1) } else { A[c(pivot, r), i:nc] <- A[c(r, pivot), i:nc] A[r, i:nc] <- A[r, i:nc] / A[r, i] if (r == 1) { ridx <- c((r+1):nr) } else if (r == nr) { ridx <- c(1:(r-1)) } else { ridx <- c(1:(r-1), (r+1):nr) } A[ridx, i:nc] <- A[ridx, i:nc] - A[ridx, i, drop=FALSE] %*% A[r, i:nc, drop=FALSE] if (r == nr) break r <- r+1 } } A[abs(A) < tol] <- 0 return(A) } pracma/R/bernoulli.R0000755000176200001440000000172412542737347014061 0ustar liggesusers## ## b e r n o u l l i . R Bernoulli numbers and polynomials ## bernoulli <- function(n, x) { stopifnot(length(n) == 1, floor(n) == ceiling(n), n >= 0) if (missing(x)) { if (n == 0) return(1.0) bf <- function(n) -n * zeta(1-n) bx <- c(1.0, sapply(1:n, bf)) bx[2] <- -0.5 } else { stopifnot(is.numeric(x)) bn <- bernoulli(n) cn <- choose(n, 0:n) bx <-polyval(cn*bn, x) } bx } # euler <- function(n) { # stopifnot(length(n) >= 1, floor(n) == ceiling(n)) # if (n == 0) return(1) # en <- numeric(n) # en[1] <- 0.0 # en[2] <- -1.0 # if (n < 4) return(c(1.0, en[1:n])) # for (m in 2:floor(n/2)) { # s <- 1.0 # for (k in 1:(m-1)) { # r = 1.0 # for (j in 1:(2*k)) { # r <- r * (2*m - 2*k + j) / j # } # s <- s + r*en[2*k] # } # en[2*m] <- (-s) # } # c(1.0, en) # } pracma/R/ode23s.R0000644000176200001440000000551212660202404013137 0ustar liggesusersode23s <- function(f, t0, tfinal, y0, jac = NULL, ..., rtol = 1e-03, atol = 1e-06, hmax = 0.0) { stopifnot(is.numeric(y0), is.numeric(t0), length(t0) == 1, is.numeric(tfinal), length(tfinal) == 1) if (t0 >= tfinal) warning("'t0 >= tfinal' may lead to incorrect behavior or results.") if (is.vector(y0)) { y0 <- as.matrix(y0) } else if (is.matrix(y0)) { if (ncol(y0) != 1) stop("Argument 'y0' must be a vector or single column matrix.") } fun <- match.fun(f) f <- function(t, y) fun(t, y, ...) if (length(f(t0, y0)) != length(y0)) stop("Argument 'f' does not describe a system of equations.") n <- length(y0); m <- length(f(t, y0)) # use finite difference Jacobian if (is.null(jac)) { jac <- function(t, x) { jacob <- matrix(NA, m, n) hh <- numeric(n); heps <- 5e-06 for (i in 1:n) { hh[i] <- heps jacob[, i] <- (f(t, x+hh) - f(t, x-hh)) / (2*heps) hh[i] <- 0 } jacob } } # Set initial parameters d <- 1/(2 + sqrt(2)) cc <- 1/2 e32 <- 6 + sqrt(2) t <- t0 tdir <- sign(tfinal - t) h <- tdir * 0.01 * (tfinal - t) if (hmax == 0.0) hmax <- 0.1 * abs(tfinal - t) hmin <- min(16 * eps(tfinal - t), h) y <- as.matrix(y0) tout <- c(t) yout <- c(y) # Main loop while (abs(t) < abs(tfinal) && hmin < abs(h)) { if (abs(t - tfinal) < abs(h)) h <- tfinal - t J <- jac(t, y) # approximate time-derivative of f T <- (f(t + 0.01*h, y) - f(t, y)) / (0.01*h) # Wolfbrandt coefficient W <- eye(length(y0)) - h * d * J # modified Rosenbrock formula F1 <- f(t, y) k1 <- qr.solve(W, F1 + h * d * T) F2 <- f(t + cc * h, y + cc * h * k1) k2 <- qr.solve(W, F2 - k1) + k1 # 2nd and 3rd order estimates ynew <- y + h * k2 F3 = f(t + h, ynew) k3 = qr.solve(W, (F3 - e32*(k2 - F2) - 2*(k1 - F1) + h*d*T)) # estimate error and acceptable error err <- h/6 * Norm(k1 - 2*k2 + k3) tau <- max(rtol * max(Norm(y),Norm(ynew)), atol) # check if new solution is acceptable if (err <= tau) { t <- t + h tout <- c(tout, t) y <- ynew yout <- cbind(yout, y) if (err == 0) err <- eps()/2 # h <- min(hmax, 1.25*h) } else { if (h <= hmin) warning("ode23s: Requested step size too small!") # h <- max(hmin, 0.5*h) } # update the step size h <- tdir * min(hmax, abs(h)*0.8*(tau/err)^(1/3)) if (abs(h) > hmax) h <- sign(h)*hmax } return(list(t = c(tout), y = t(yout))) } pracma/R/mode.R0000644000176200001440000000111013777657740013005 0ustar liggesusers## ## m o d e . R ## Mode <- function(x) { if (all(is.na(x))) return(NA) if (is.matrix(x)) x <- c(x) if (is.numeric(x)) { x <- sort(x) tbl <- table(x) n <- which.max(tbl) xm <- as.numeric(names(tbl)[n]) } else if (is.complex(x)) { x <- x[order(abs(x))] tbl <- table(x) n <- which.max(tbl) xm <- as.complex(names(tbl)[n]) } else if (is.factor(x)) { tbl <- table(x) n <- which.max(tbl) xm <- names(tbl)[n] } else xm <- NA return(xm) } pracma/R/spinterp.R0000644000176200001440000000522311650565424013717 0ustar liggesusers## ## s p i n t e r p . R ## spinterp <- function(x, y, xp) { stopifnot(is.numeric(x), is.numeric(y), is.numeric(xp)) stopifnot(is.vector(x), is.vector(y), is.vector(xp)) n <- length(x) n1 <- n - 1 if (n <= 3) stop("Length of arguments 'x', 'y' must be greater than 3.") if (length(y) != n) stop("Arguments 'x', 'y' must be vectors of the same length.") if(any(is.na(y))) stop("NAs are not allowed in argument 'y'.") # M o n o t o n i c i t y h <- diff(x) dy <- diff(y) if (any(h <= 0)) stop("Argument 'x' must be a sorted list af real values.") if (any(dy < 0)) stop("Argument 'y' must be monotonically increasing.") # C o n v e x i t y delta <- dy / h dd <- diff(delta) cnvx <- if (all(dd > 0)) TRUE else FALSE # Approximate the derivatives at all data points if (cnvx) d_mode <- "harmonic" else d_mode <- "geometric" d <- rep(NA, n) d[1] <- delta[1] d[n] <- delta[n1] if (d_mode == "arithmetic") { for (j in 2:n1) d[j] <- (h[j]*delta[j-1] + h[j-1]*delta[j]) / (h[j] + h[j-1]) } else if (d_mode == "geometric") { for (j in 2:n1) { d[j] <- (delta[j-1]^h[j] * delta[j]^h[j-1])^(1/(h[j-1]+h[j])) } } else if (d_mode == "harmonic") { for (j in 2:n1) { d[j] <- (h[j] + h[j-1]) / (h[j]/delta[j-1] + h[j-1]/delta[j]) } } # "C u b i c i t y" r <- rep(3, n1) if (!cnvx) r_mode <- "monotonic" # a n d monotone else r_mode <- "otherwise" r_mode <- "monotonic" # Fix to "monotonic" for the moment ! # Now define the r-values for Delbourg & Gregory if (r_mode == "monotonic") { k <- which(delta != 0) #r <- 1 + (d[1:n1] + d[2:n]) / delta # strictly monotonic r[k] <- (d[k] + d[k+1]) / delta[k] } else if (r_mode == "otherwise") { for (j in 1:n1) { r[j] <- 1 + (d[j+1]-delta[j]) / (delta[j]-d[j]) + (delta[j]-d[j]) / (d[j+1]-delta[j]) } } # Apply cubic Delbourgo & Gregory formula m <- length(xp) fi <- findInterval(xp, x) yp <- rep(NA, m) for (j in 1:m) { i <- fi[j] # findInterval(xp[j], x) if (i < n) { theta <- (xp[j] - x[i]) / h[i] P <- y[i+1] * theta^3 + (r[i]*y[i+1] - h[i]*d[i+1]) * theta^2 * (1-theta) + (r[i]*y[i] + h[i]*d[i]) * theta * (1-theta)^2 + y[i] * (1-theta)^3 Q <- 1 + (r[i]-3) * theta * (1-theta) yp[j] <- P / Q } else { yp[j] <- y[n] } } return(yp) } pracma/R/kriging.R0000644000176200001440000000305012051653453013475 0ustar liggesusers## ## k r i g i n g . R Kriging Interpolation ## kriging <- function(u, v, u0, type = c("ordinary", "simple")) { stopifnot(is.numeric(u), is.numeric(v), is.numeric(u0)) if (!is.matrix(u)) stop("Argument 'u' must be a numeric matrix.") n <- nrow(u); m <- ncol(u) if (is.vector(v)) { if (length(v) != n) stop("Length of vector 'v' must be equal to ncol(u).") } else if (is.matrix(v)) { if (ncol(v) == 1 || nrow(v) == n) { v <- c(v) } else stop("As matrix 'v' must be a column vector (with ncol(u) elements).") } else { stop("Argument 'v' must be a vector or matrix (with ncol(u) elements).") } if (is.vector(u0)) { if (length(u0) == m) { u0 <- t(u0) } else { stop("Length of vector 'u0' must be equal to ncol(u).") } } else if (is.matrix(u0)) { if (ncol(u0) != m) stop("Matrix 'u0' must have the same number of colums as 'u'.") } else stop("Argument 'u0' must be a vector or matrix (with ncol(u) elements).") type <- match.arg(type) # Define the Variogram V <- distmat(u, u) U0 <- distmat(u, u0) # Compute kriging formula if (type == "simple") { w <- v %*% inv(V) %*% U0 } else if (type == "ordinary") { k <- nrow(u0) C <- matrix(1, n+1, n+1) C[1:n, 1:n] <- V C[n+1, n+1] <- 0 D <- matrix(1, n+1, k) D[1:n, 1:k] <- U0 v <- c(v, 0) w <- v %*% inv(C) %*% D } else # ntype = 0 stop("Argument 'type' can only be 'simple' or 'ordinary'.") drop(w) # return as vector } pracma/R/complexstep.R0000644000176200001440000000524112270767723014423 0ustar liggesusers## ## c o m p l e x s t e p . R Complex Step Derivation ## complexstep <- function(f, x0, h = 1e-20, ...) { stopifnot(is.numeric(x0), is.numeric(h), h < 1e-15) fun <- match.fun(f) f <- function(x) fun(x, ...) try(fx0hi <- f(x0 + h*1i)) if (inherits(fx0hi, "try-error")) stop("Function 'f' does not appear to accept complex arguments.") if (!is.complex(fx0hi) || !is.double(f(x0))) { # apply Richardson's method f_csd <- numderiv(f, x0, h = 0.1)$df warning("Some maginary part is zero: applied Richardson instead.") } else { # apply complex-step method f_csd <- Im(fx0hi) / h # Im(f(x0 + h * 1i)) / h } return(f_csd) } grad_csd <- function(f, x0, h = 1e-20, ...) { fun <- match.fun(f) f <- function(x) fun(x, ...) z <- f(x0) n <- length(x0); m <- length(z) if (m > 1) stop("Funktion 'f' does not return a scalar; call 'Jacobian_csd'.") G <- rep(NA, n) for (k in 1:n) { x1 <- x0 x1[k] <- x1[k] + h * 1i G[k] <- Im(f(x1)) / h } return(G) } jacobian_csd <- function(f, x0, h = 1e-20, ...) { fun <- match.fun(f) f <- function(x) fun(x, ...) z <- f(x0) n <- length(x0); m <- length(z) J <- matrix(NA, nrow = m, ncol = n) for (k in 1:n) { x1 <- x0 x1[k] <- x1[k] + h * 1i J[ , k] <- Im(f(x1)) / h } # drop matrix dimensions if n = m = 1 # if (m == 1 && n == 1) J <- J[,] return(J) } hessian_csd <- function(f, x0, h = 1e-20, ...) { fun <- match.fun(f) f <- function(x) fun(x, ...) z <- f(x0) n <- length(x0); m <- length(z) if (m > 1) stop("Funktion 'f' does not return a scalar, as needed for Hessian.") H <- matrix(NA, nrow = n, ncol = n) for (i in 1:n) { fi <- function(x) { x[i] <- x[i] + h*1i Im(f(x)) / h } for (j in 1:n) { ff <- function(x) { xx <- x0 xx[j] <- x fi(xx) } H[i, j] <- numderiv(ff, x0[j])$df } } return(H) } laplacian_csd <- function(f, x0, h = 1e-20, ...) { fun <- match.fun(f) f <- function(x) fun(x, ...) z <- f(x0) n <- length(x0); m <- length(z) if (m > 1) stop("Funktion 'f' does not return a scalar, as needed for Lapacian.") L <- rep(NA, n) for (i in 1:n) { fi <- function(x) { x[i] <- x[i] + h*1i Im(f(x)) / h } ff <- function(x) { xx <- x0 xx[i] <- x fi(xx) } L[i] <- numderiv(ff, x0[i])$df } return(sum(L)) } pracma/R/gaussNewton.R0000644000176200001440000000474712036023205014363 0ustar liggesusers## ## g a u s s N e w t o n . R Gauss-Newton Function Minimization ## gaussNewton <- function(x0, Ffun, Jfun = NULL, maxiter =100, tol = .Machine$double.eps^(1/2), ...) { if (!is.numeric(x0)) stop("Argument 'x0' must be a numeric vector.") x0 <- c(x0) n <- length(x0) if (n == 1) stop("Function is univariate -- use a different approach.") Fun <- match.fun(Ffun) F <- function(x) Fun(x, ...) m <- length(F(x0)) # Define J as Jacobian of F, and f as sum(F_i) f <- function(x) sum(F(x)^2) if (is.null(Jfun)) { J <- function(x) jacobian(F, x) } else { Jun <- match.fun(Jfun) J <- function(x) Jun(x, ...) } # The gradient g of f (!) computed through the Jacobian g <- function(x) 2 * t(J(x)) %*% F(x) # First iteration xk <- x0 fk <- f(xk) Jk <- J(xk) gk <- g(xk) # 2 * t(Jk) %*% F(xk) Hk <- 2 * t(Jk) %*% Jk + tol * diag(1, n) # Line search step dk <- -inv(Hk) %*% gk if (!all(is.finite(dk))) dk <- .mdhess(Hk, gk) ak <- softline(xk, dk, f, g) adk <- ak * dk err <- Norm(adk) k <- 1 while (err > tol && k < maxiter) { xk <- xk + adk fl <- f(xk) Jk <- J(xk) gk <- g(xk) Hk <- 2 * t(Jk) %*% Jk + tol * diag(1, n) dk <- -inv(Hk) %*% gk if (!all(is.finite(dk))) dk <- .mdhess(Hk, gk) ak <- softline(xk, dk, f, g) adk <- ak * dk err <- abs(fl - fk) # Prepare next iteration fk <- fl k <- k + 1 } if (k >= maxiter) warning("Maximum number of iterations reached -- no convergence.") xs <- c(xk + adk) fs <- f(xk + adk) return(list(xs = xs, fs = fs, niter = k, relerr = err)) } .mdhess <- function(H, gk) { n <- length(gk) # Matthews-Davies algorithm L <- D <- matrix(0, n, n) h00 <- if (H[1, 1] > 0) H[1, 1] else 1 for (k in 2:n) { m <- k-1 L[m, m] <- 1 if (H[m, m] <= 0) H[m, m] <- h00 for (i in k:n) { L[i, m] <- -H[i, m] / H[m, m] H[i, m] <- 0 for (j in k:n) { H[i, j] <- H[i, j] + L[i, m] * H[m, j] } } if (H[k, k] > 0 && H[k, k] < h00) h00 <- H[k, k] } L[n, n] <- 1 if (H[n,n] <= 0) H[n, n] <- h00 for (i in 1:n) D[i, i] <- H[i, i] # Determine direction vector yk <- -L %*% gk dk <- t(L) %*% diag(1/diag(D)) %*% yk return(dk) } pracma/R/expm.R0000644000176200001440000000230113400575546013017 0ustar liggesusers## ## e x p m . R Matrix Exponential ## expm <- function(A, np = 128) { if (!is.numeric(A) || !is.matrix(A) || nrow(A) != ncol(A)) stop("Argument 'A' must be a square numeric matrix.") if (!is.numeric(np) || length(np) != 1 || floor(np) != ceiling(np) || np < 2) stop("Argument 'np' must be an integer greater or equal to 2.") N <- nrow(A) circle <- exp(2i*pi*(1:np)/np) # generate np unit roots z0 <- ceiling(mean(range(Re(eig(A)))) + 0.1) radius <- ceiling(max(abs(eig(A) - z0)) + 0.1) z <- z0 + radius*circle I <- eye(N); B <- zeros(N) for (i in 1:np) { R <- inv(z[i]*I - A) # resolvent matrix at point z(i) B <- B + R * (z[i]-z0) * exp(z[i]) # add up contributions to integral } B <- Re(B)/np return(zapsmall(B)) } logm <- function(A) { if (!is.numeric(A) || !is.matrix(A) || nrow(A) != ncol(A)) stop("Argument 'A' must be a square numeric matrix.") E <- eigen(A) e <- E$values if (any(Im(e) == 0 & Re(e) <= 0)) stop("A must not have any nonpositive real eigenvalues.") D <- diag(log(E$values)) X <- E$vectors %*% D %*% solve(E$vectors) return(Re(X)) }pracma/R/wilkinson.R0000644000176200001440000000041112030655336014055 0ustar liggesusers## ## w i l k i n s o n . R Wilkinson matrix ## wilkinson <- function(n){ if (length(n) != 1 || n != round(n)) stop("Argument 'n' must be an integer.") if (n <= 0) return(c()) m <- (n-1)/2.0 r <- rep(1, n-1) Diag(abs(-m:m)) + Diag(r, 1) + Diag(r, -1) } pracma/R/cutpoints.R0000644000176200001440000000147711670172133014103 0ustar liggesuserscutpoints <- function(x, nmax = 8, quant = 0.95) { stopifnot(is.numeric(x), is.numeric(nmax), is.numeric(quant)) if (length(nmax) != 1 || floor(nmax) != ceiling(nmax) || nmax <= 0) stop("Argument 'nmax' must be a positive integer.") if (length(quant) != 1 || quant < 0 || quant > 1) stop("Argument 'quant' must be a numeric value in [0,1].") if (length(x) == 1) return(list(cutp = c(), cutd = c())) if (!is.vector(x)) x <- c(x) if (is.unsorted(x)) x <- sort(x) d <- diff(x) if (quant == 0.0) n <- nmax else { q <- quantile(d, probs = quant) n <- min(nmax, sum(d >= q)) } o <- order(d) inds <- o[length(d):(length(d)-(n-1))] dc <- d[inds] xc <- x[inds] + dc/2 o <- order(xc) return(list(cutp = xc[o], cutd = dc[o])) } ## Example pracma/R/pade.R0000644000176200001440000000267312001565513012760 0ustar liggesusers## ## p a d e . R Pade Approximation ## pade <- function(p1, p2 = c(1), d1 = 5, d2 = 5) { stopifnot(is.numeric(p1), is.numeric(p2), is.numeric(d1), length(d1) == 1, floor(d1) == ceiling(d1), d1 >= 0, is.numeric(d2), length(d2) == 1, floor(d2) == ceiling(d2), d2 >= 0) if (d1 == 0 && d2 == 0) return(list(r1 = p1[length(p1)], r2 = p2[length(p2)])) z <- rep(0, d1 + d2 + 3) p2 <- rev(c(z, p2))[1:(d1+d2+3)] p1 <- rev(c(z, p1))[1:(d1+d2+3)] L <- Toeplitz(p2[1:(d1+d2)]); L[upper.tri(L)] <- 0 R <- Toeplitz(p1[1:(d1+d2)]); R[upper.tri(R)] <- 0 # generate the linear system of coefficient equations D1 <- if (d1 > 0) 1:d1 else c() D2 <- if (d2 > 0) 1:d2 else c() A <- cbind(L[, D1], -R[, D2]) b <- p2[1]*p1[2:(d1+d2+1)] - p1[1]*p2[2:(d1+d2+1)] # imitate pinv() if some eigenvalues are zero P <- svd(A); U <- P$u; V <- P$v; s <- P$d r <- sum(s > max(dim(A)) * max(s) * .Machine$double.eps) if (r == 0) { pinvA <- matrix(0, nrow = nrow(A), ncol = ncol(A)) } else { S <- diag(1/s[1:r]) pinvA <- V[, 1:r] %*% S %*% t(U[, 1:r]) } # solve the linear system of coefficient equations B <- zapsmall(pinvA %*% b) # reconstruct the rational function r1 <- rev(c(p1[1], B[1:d1])) r2 <- rev(c(p2[1], B[(d1+1):length(B)])) # scale such that max(r2) = 1 rmax <- max(abs(r2)) if (rmax == 0) rmax <- 1 r1 <- r1 / rmax r2 <- r2 / rmax # return numerator and denominator return(list(r1 = r1, r2 = r2)) } pracma/R/movavg.R0000644000176200001440000000266514024777552013366 0ustar liggesusers## ## m o v a v g . R Moving Average Filters ## movavg <- function(x, n, type=c("s", "t", "w", "m", "e", "r")) { stopifnot(is.numeric(x), is.numeric(n), is.character(type)) if (length(n) != 1 || ceiling(n != floor(n)) || n <= 1) stop("Window length 'n' must be a single integer greater 1.") nx <- length(x) if (n >= nx) stop("Window length 'n' must be greater then length of time series.") y <- numeric(nx) type <- match.arg(type) if (type == "s") { # simple for (k in 1:(n-1)) y[k] <- mean(x[1:k]) for (k in n:nx) y[k] <- mean(x[(k-n+1):k]) } else if (type == "t") { # triangular n <- ceiling((n + 1)/2) s <- movavg(x, n, "s") y <- movavg(s, n, "s") } else if (type == "w") { # weighted for (k in 1:(n-1)) y[k] <- 2 * sum((k:1)*x[k:1]) / (k*(k+1)) for (k in n:nx) y[k] <- 2 * sum((n:1)*x[k:(k-n+1)]) / (n*(n+1)) } else if (type == "m") { # modified y[1] <- x[1] for (k in 2:nx) y[k] <- y[k-1] + (x[k] - y[k-1])/n } else if (type == "e") { # exponential a <- 2/(n+1) y[1] <- x[1] for (k in 2:nx) y[k] <- a*x[k] + (1-a)*y[k-1] } else if (type == "r") { # running a <- 1/n y[1] <- x[1] for (k in 2:nx) y[k] <- a*x[k] + (1-a)*y[k-1] } else stop("The type must be one of 's', 't', 'w', 'm', 'e', or 'r'.") return(y) } pracma/R/findpeaks.R0000644000176200001440000000500013231236405013777 0ustar liggesusersfindpeaks <- function(x,nups = 1, ndowns = nups, zero = "0", peakpat = NULL, # peakpat = "[+]{2,}[0]*[-]{2,}", minpeakheight = -Inf, minpeakdistance = 1, threshold = 0, npeaks = 0, sortstr = FALSE) { stopifnot(is.vector(x, mode="numeric") || length(is.na(x)) == 0) if (! zero %in% c('0', '+', '-')) stop("Argument 'zero' can only be '0', '+', or '-'.") # transform x into a "+-+...-+-" character string xc <- paste(as.character(sign(diff(x))), collapse="") xc <- gsub("1", "+", gsub("-1", "-", xc)) # transform '0' to zero if (zero != '0') xc <- gsub("0", zero, xc) # generate the peak pattern with no of ups and downs if (is.null(peakpat)) { peakpat <- sprintf("[+]{%d,}[-]{%d,}", nups, ndowns) } # generate and apply the peak pattern rc <- gregexpr(peakpat, xc)[[1]] if (rc[1] < 0) return(NULL) # get indices from regular expression parser x1 <- rc x2 <- rc + attr(rc, "match.length") attributes(x1) <- NULL attributes(x2) <- NULL # find index positions and maximum values n <- length(x1) xv <- xp <- numeric(n) for (i in 1:n) { xp[i] <- which.max(x[x1[i]:x2[i]]) + x1[i] - 1 xv[i] <- x[xp[i]] } # eliminate peaks that are too low inds <- which(xv >= minpeakheight & xv - pmax(x[x1], x[x2]) >= threshold) # combine into a matrix format X <- cbind(xv[inds], xp[inds], x1[inds], x2[inds]) # eliminate peaks that are near by if (minpeakdistance < 1) warning("Handling 'minpeakdistance < 1' is logically not possible.") # sort according to peak height if (sortstr || minpeakdistance > 1) { sl <- sort.list(X[, 1], na.last = NA, decreasing = TRUE) X <- X[sl, , drop = FALSE] } # return NULL if no peaks if (length(X) == 0) return(c()) # find peaks sufficiently distant if (minpeakdistance > 1) { no_peaks <- nrow(X) badpeaks <- rep(FALSE, no_peaks) # eliminate peaks that are close to bigger peaks for (i in 1:no_peaks) { ipos <- X[i, 2] if (!badpeaks[i]) { dpos <- abs(ipos - X[, 2]) badpeaks <- badpeaks | (dpos > 0 & dpos < minpeakdistance) } } # select the good peaks X <- X[!badpeaks, , drop = FALSE] } # Return only the first 'npeaks' peaks if (npeaks > 0 && npeaks < nrow(X)) { X <- X[1:npeaks, , drop = FALSE] } return(X) } pracma/R/crossn.R0000644000176200001440000000073211540452742013356 0ustar liggesusers## ## c r o s s n . R Vector Cross Product ## crossn <- function(A) { if (!is.numeric(A)) stop("Argument 'A' must be numeric.") if (is.vector(A) && length(A) == 2) { crossA <- c(A[2], -A[1]) } else { if (is.matrix(A) && nrow(A) >= 2 && ncol(A) == nrow(A) + 1) { m <- ncol(A) crossA <- numeric(m) for (i in 1:m) crossA[i] <- (-1)^(i+1) * det(A[, -i]) } else { stop("Matrix 'A' must be of size n x (n+1) with n >= 1.") } } return(crossA) } pracma/R/eigjacobi.R0000644000176200001440000000200312062032441013742 0ustar liggesusers## ## e i g j a c o b i . R Jacobi Eigenvalue Method ## eigjacobi <- function(A, tol = .Machine$double.eps^(2/3)) { stopifnot(is.numeric(A)) n <- nrow(A) if (ncol(A) != n || any(t(A) != A)) stop("Matrix 'A' must be a square and real symmetric matrix.") D <- A V <- eye(n) # calculate greatest off-diagonal element ind <- which.max(abs(D - diag(diag(D)))) pq <- arrayInd(ind, dim(D)) p <- pq[1]; q <- pq[2] while (TRUE) { # Zero out D[p, q] and D[q, p] t <- D[p,q] / (D[q,q] - D[p,p]) d <- 1/sqrt(t^2 + 1) s <- d * t R <- matrix(c(d, -s, s, d), 2, 2) D[c(p, q), ] <- t(R) %*% D[c(p, q), ] D[, c(p, q)] <- D[, c(p, q)] %*% R V[, c(p, q)] <- V[, c(p, q)] %*% R ind <- which.max(abs(D - diag(diag(D)))) pq <- arrayInd(ind, dim(D)) p <- pq[1]; q <- pq[2] if (abs(D[p,q]) < tol * sqrt(sum(diag(D)^2)/n)) break } return(list(V = V, D = diag(D))) } pracma/R/legendre.R0000644000176200001440000000147113121271145013626 0ustar liggesusers## ## l e g e n d r e . R Legendre Functions ## legendre <- function(n, x) { stopifnot(is.numeric(x), is.numeric(n), length(n) == 1, floor(n) == ceiling(n), n >= 0) x <- c(x) N <- length(x) if (n == 0) return(rep(1, N)) # generate the Legendre polynomials up to degree n Lp <- matrix(0, n+1, n+1) Lp[1, n+1] <- Lp[2, n] <- 1 if (n > 1) { for (i in 3:(n+1)) { j <- i-1 Lp[i, (n-i+2):(n+1)] <- (2*j-1)/j * c(Lp[i-1, (n-i+3):(n+1)], 0) - (j-1)/j * Lp[i-2, (n-i+2):(n+1)] } } lp <- Lp[n+1, ] # associated Legendre functions up to order n L <- matrix(NA, n+1, N) L[1, ] <- polyval(lp, x) for (j in 1:n) { lp <- polyder(lp) L[j+1, ] <- (-1)^j * sqrt((1-x^2)^j) * polyval(lp, x) } return(L) } pracma/R/lsqnonneg.R0000644000176200001440000000256212301624171014047 0ustar liggesuserslsqnonneg <- function(C, d) { stopifnot(is.numeric(C), is.numeric(d)) if (!is.matrix(C) || !is.vector(d)) stop("Argument 'C' must be a matrix, 'd' a vector.") m <- nrow(C); n <- ncol(C) if (m != length(d)) stop("Arguments 'C' and 'd' have nonconformable dimensions.") tol = 10 * eps() * norm(C, type = "2") * (max(n, m) + 1) x <- rep(0, n) # initial point P <- logical(n); Z <- !P # non-active / active columns resid <- d - C %*% x w <- t(C) %*% resid wz <- numeric(n) # iteration parameters outeriter <- 0; it <- 0 itmax <- 3 * n; exitflag <- 1 while (any(Z) && any(w[Z] > tol)) { outeriter <- outeriter + 1 z <- numeric(n) wz <- rep(-Inf, n) wz[Z] <- w[Z] im <- which.max(wz) P[im] <- TRUE; Z[im] <- FALSE z[P] <- qr.solve(C[, P], d) while (any(z[P] <= 0)) { it <- it + 1 if (it > itmax) stop("Iteration count exceeded.") Q <- (z <= 0) & P alpha <- min(x[Q] / (x[Q] - z[Q])) x <- x + alpha*(z - x) Z <- ((abs(x) < tol) & P) | Z P <- !Z z <- numeric(n) z[P] <- qr.solve(C[, P], d) } x <- z resid <- d - C %*% x w <- t(C) %*% resid } return(list(x = x, resid.norm = sum(resid*resid))) } pracma/R/lambertW.R0000644000176200001440000000352612421020763013621 0ustar liggesusers## ## l a m b e r t W . R Lambert W Function ## lambertWp <- function(x) { if (!is.numeric(x)) stop("Argument 'x' must be a numeric (real) vector.") if (length(x) == 1) { if (x < -1/exp(1)) return(NaN) if (x == -1/exp(1)) return(-1) # compute first iteration of $W_0$ if (x <= 1) { eta <- 2 + 2*exp(1)*x; f2 <- 3*sqrt(2) + 6 - (((2237+1457*sqrt(2))*exp(1) - 4108*sqrt(2) - 5764)*sqrt(eta)) / ((215+199*sqrt(2))*exp(1) - 430*sqrt(2)-796) f1 <- (1-1/sqrt(2))*(f2+sqrt(2)); w0 <- -1 + sqrt(eta)/(1 + f1*sqrt(eta)/(f2 + sqrt(eta))); } else { w0 = log( 6*x/(5*log( 12/5*(x/log(1+12*x/5)) )) ) } # w0 <- 1 w1 <- w0 - (w0*exp(w0)-x)/((w0+1)*exp(w0)-(w0+2)*(w0*exp(w0)-x)/(2*w0+2)) while(abs(w1-w0) > 1e-15) { w0 <- w1 w1 <- w0 - (w0*exp(w0)-x)/((w0+1)*exp(w0)-(w0+2)*(w0*exp(w0)-x)/(2*w0+2)) } return(w1) } else { sapply(x, lambertWp) } } lambertWn <- function(x) { if (!is.numeric(x)) stop("Argument 'x' must be a numeric (real) scalar.") if (length(x) == 1) { if (x < -exp(-1) || x >= 0) return(NaN) if (x == exp(-1)) return(-1) # compute first approximation of $W_-1$ m1 <- 0.3361; m2 <- -0.0042; m3 <- -0.0201 sigma <- -1 - log(-x) w0 <- -1 - sigma - 2/m1*(1-1/(1 + (m1*sqrt(sigma/2)) / (1 + m2*sigma*exp(m3*sqrt(sigma))))) r <- abs(x - w0*exp(w0)) while (r > 1e-15) { w1 <- w0 - (w0*exp(w0)-x) / (exp(w0)*(w0+1)-(w0+2)*(w0*exp(w0)-x)/(2*w0+2)) r <- abs(x - w1*exp(w1) ) w0 <- w1 } return(w0) } else { sapply(x, lambertWn) } } pracma/R/dot.R0000755000176200001440000000105111540452742012633 0ustar liggesusers### ### DOT.R Scalar product ### dot <- function(x, y) { if (length(x) == 0 && length(y) == 0) return(0) if (!(is.numeric(x) || is.complex(x)) || !(is.numeric(y) || is.complex(y))) stop("Arguments 'x' and 'y' must be real or complex.") x <- drop(x); y <- drop(y) if (any(dim(x) != dim(y))) stop("Matrices 'x' and 'y' must be of same size") if (is.vector(x) && is.vector(y)) { dim(x) <- c(length(x), 1) dim(y) <- c(length(y), 1) } x.y <- apply(Conj(x) * y, 2, sum) return(x.y) } pracma/R/findzeros.R0000644000176200001440000000421712155035300014042 0ustar liggesusers## ## f i n d z e r o s . R Find all roots or minima ## findzeros <- function(f, a, b, n = 100, tol = .Machine$double.eps^(2/3), ...) { stopifnot(is.numeric(a), length(a) == 1, is.numeric(b), length(b) == 1, is.numeric(n), floor(n) == ceiling(n), n >= 2) if (! a < b) stop("Left interval border must be smaller than right one.") fun <- match.fun(f) f <- function(x) fun(x, ...) h <- (b - a) / n x <- seq(a, b, by = h) # length(x) == n+1 y <- f(x) R <- c() s <- sign(f(x[1])) if (abs(f(x[1])) < tol) { R <- c(x[1]) s <- 0 } for (i in 2:n) { si <- sign(f(x[i])) if (abs(f(x[i])) < tol) { R <- c(R, x[i]) si <- 0 } else if (s * si < 0) { # function values have different sign, != 0 u <- uniroot(f, c(x[i-1], x[i])) R <- c(R, u$root) } else if (s * si > 0) { # function values both positive or negative xm <- (x[i-1] + x[i])/2 ym <- f(xm) d <- (y[i] - y[i-1])/h if (d == 0) next xv <- xm - ym/d if (xv > x[i-1] && xv < x[i]) { if (s > 0) { s <- optimize(f, c(x[i-1], x[i]), tol = tol) sm <- s$minimum } else { s <- optimize(f, c(x[i-1], x[i]), maximum = TRUE, tol = tol) sm <- s$maximum } if (abs(s$objective) < tol) R <- c(R, sm) } } s <- si } if (abs(f(x[n+1])) < tol) R <- c(R, x[n+1]) return(R) } findmins <- function(f, a, b, n = 100, tol = .Machine$double.eps^(2/3), ...) { stopifnot(is.numeric(a), length(a) == 1, is.numeric(b), length(b) == 1, is.numeric(n), floor(n) == ceiling(n), n >= 2) if (! a < b) stop("Left interval border must be smaller than right one.") fun <- match.fun(f) f <- function(x) fun(x, ...) h <- (b - a) / n x <- seq(a, b, by = h) # length(x) == n+1 R <- c() for (i in 2:(n-1)) { if ( (f(x[i]) - f(x[i-1]) < 0) && (f(x[i+1]) - f(x[i])) > 0 ) { o <- optimize(f, c(x[i-1], x[i+1])) R <- c(R, o$minimum) } } return(R) } pracma/R/hyperbolic.R0000644000176200001440000000260012057642712014205 0ustar liggesusers## ## h y p e r b o l i c . R Hyperbolic Functions ## ### More trigonometric functions ### # cotangens cot <- function(z) { stopifnot(is.numeric(z) || is.complex(z)) 1 / tan(z) } # cosecans csc <- function(z) { stopifnot(is.numeric(z) || is.complex(z)) 1 / sin(z) } # secans sec <- function(z) { stopifnot(is.numeric(z) || is.complex(z)) 1 / cos(z) } # arcus cotangens acot <- function(z) { stopifnot(is.numeric(z) || is.complex(z)) atan(1/z) } #arcus cosecans acsc <- function(z) { stopifnot(is.numeric(z) || is.complex(z)) asin(1/z) } # arcus secans asec <- function(z) { stopifnot(is.numeric(z) || is.complex(z)) acos(1/z) } ### More hyperbolic functions ### # hyperbolic cotangens coth <- function(z) { stopifnot(is.numeric(z) || is.complex(z)) 1 / tanh(z) } # hyperbolic cosecans csch <- function(z) { stopifnot(is.numeric(z) || is.complex(z)) 1 / sinh(z) # 2 / (exp(z) - exp(-z)) } # hyperbolic secans sech <- function(z) { stopifnot(is.numeric(z) || is.complex(z)) 1 / cosh(z) # 2 / (exp(z) + exp(-z)) } # area cotangens acoth <- function(z) { stopifnot(is.numeric(z) || is.complex(z)) atanh(1/z) } # area cosecans acsch <- function(z) { stopifnot(is.numeric(z) || is.complex(z)) asinh(1/z) } # area secans asech <- function(z) { stopifnot(is.numeric(z) || is.complex(z)) acosh(1/z) } pracma/R/strfind.R0000644000176200001440000000210311542722330013505 0ustar liggesusers## ## s t r f i n d . R Find Substrings ## strfind <- function(s1, s2, overlap = TRUE) { stopifnot(is.character(s1), is.character(s2)) if (length(s2) != 1) stop("Pattern 's2' must be a character vector of length 1.") L <- list() for (i in 1:length(s1)) { si <- s1[i] if (nchar(si) < nchar(s2)) { L[[i]] <- c() } else { L[[i]] <- findstr(s2, si, overlap=overlap) } } if (length(s1) == 1) L <- unlist(L) return(L) } strfindi <- function(s1, s2, overlap = TRUE) { stopifnot(is.character(s1), is.character(s2)) strfind(tolower(s1), tolower(s2), overlap=overlap) } findstr <- function(s1, s2, overlap = TRUE) { stopifnot(is.character(s1), is.character(s2)) if (length(s1) != 1 || length(s2) != 1) stop("Arguments must be character vectors of length 1.") if (nchar(s1) > nchar(s2)) { s <- s1; s1 <- s2; s2 <- s } if (s1 == '') return(c()) n1 <- nchar(s1) n2 <- nchar(s2) r <- c() i <- 1 while (i <= n2 - n1 + 1) { if (s1 == substring(s2, i, i + n1 - 1)) { r <- c(r, i) if (!overlap) i <- i + n1 - 1 } i <- i + 1 } return(r) } pracma/R/hadamard.R0000644000176200001440000000263612030655336013614 0ustar liggesusers## ## h a d a m a r d . R Hadamard Matrix ## hadamard <- function(n) { if (!is.numeric(n) || length(n) != 1 || floor(n) != ceiling(n) || n <= 1) stop("Argument 'n' must be a positiv integer.") x <- log2(c(n, n/12, n/20)) k <- which(floor(x) == ceiling(x)) if (length(k) == 0) stop("Argument 'n' is not of the form 2^e, 12*2^e , or 20*2^e.") e <- x[k] if (k == 1) { H <- c(1) } else if (k == 2) { H <- ones(12, 12) H[2:12, 2:12] <- Toeplitz(c(-1, -1, 1, -1, -1, -1, 1, 1, 1, -1, 1), c(-1, 1, -1, 1, 1, 1, -1, -1, -1, 1, -1)) } else if (k == 3) { H <- ones(20, 20) H[2:20, 2:20] <- hankel(c(-1, -1, 1, 1, -1, -1, -1, -1, 1, -1, 1, -1, 1, 1, 1, 1, -1, -1, 1), c(1, -1, -1, 1, 1, -1, -1, -1, -1, 1, -1, 1, -1, 1, 1, 1, 1, -1, -1)) } if (e >= 1) { for ( i in 1:e) { H <- matrix(c(1, 1, 1, -1), 2, 2) %x% H # Kronecker product } } return(H) } Toeplitz <- function(a, b = a) { if (!is.vector(a) || !is.vector(b)) stop("Arguments 'a' and 'b' must be vectors.") if (a[1] != b[1]) warning("First elements of vectors 'a', 'b' are not equal.") n <- length(a) m <- length(b) T <- matrix(nrow = n, ncol = m) T[1, ] <- b T[, 1] <- a for (i in 2:n) { T[i, 2:m] <- T[i-1, 1:(m-1)] } return(T) } pracma/R/brentdekker.R0000644000176200001440000000374313342034603014346 0ustar liggesusers## ## b r e n t d e k k e r . R Brent-Dekker Algorithm ## brentDekker <- function(fun, a, b, maxiter = 500, tol = 1e-12, ...) # Brent and Dekker's root finding method, # based on bisection, secant method and quadratic interpolation { fun <- match.fun(fun) f <- function(x) fun(x, ...) stopifnot(is.numeric(a), is.numeric(b), length(a) == 1, length(b) == 1) if (!is.function(f) || is.null(f)) stop("Argument 'f' must be a valid R function.") x1 <- a; f1 <- f(x1) if (f1 == 0) return(list(root = a, f.root = 0, f.calls = 1, estim.prec = 0)) x2 <- b; f2 <- f(x2) if (f2 == 0) return(list(root = b, f.root = 0, f.calls = 1, estim.prec = 0)) if (f1*f2 > 0.0) stop("Brent-Dekker: Root is not bracketed in [a, b].") x3 <- 0.5*(a+b) # Beginning of iterative loop niter <- 1 while (niter <= maxiter) { f3 <- f(x3) if (abs(f3) < tol) { x0 <- x3 break } # Tighten brackets [a, b] on the root if (f1*f3 < 0.0) b <- x3 else a <- x3 if ( (b-a) < tol*max(abs(b), 1.0) ) { x0 <- 0.5*(a + b) break } # Try quadratic interpolation denom <- (f2 - f1)*(f3 - f1)*(f2 - f3) numer <- x3*(f1 - f2)*(f2 - f3 + f1) + f2*x1*(f2 - f3) + f1*x2*(f3 - f1) # if denom==0, push x out of bracket to force bisection if (denom == 0) { dx <- b - a } else { dx <- f3*numer/denom } x <- x3 + dx # If interpolation goes out of bracket, use bisection. if ((b - x)*(x - a) < 0.0) { dx <- 0.5*(b - a) x <- a + dx; } # Let x3 <-- x & choose new x1, x2 so that x1 < x3 < x2. if (x1 < x3) { x2 <- x3; f2 <- f3 } else { x1 <- x3; f1 <- f3 } niter <- niter + 1 if (abs(x - x3) < tol) { x0 <- x break } x3 <- x; } if (niter > maxiter) warning("Maximum numer of iterations, 'maxiter', has been reached.") prec <- min(abs(x1-x3), abs(x2-x3)) return(list(root = x0, f.root = f(x0), f.calls = niter+2, estim.prec = prec)) } # alias brent <- brentDekker pracma/R/expint.R0000644000176200001440000000514012062032441013342 0ustar liggesusers## ## e x p i n t . R Exponential Integral ## expint <- function(x) { stopifnot(is.numeric(x) || is.complex(x)) eps <- .Machine$double.eps x <- c(x) n <- length(x) y <- numeric(n) p <- c(-3.602693626336023e-09, -4.819538452140960e-07, -2.569498322115933e-05, -6.973790859534190e-04, -1.019573529845792e-02, -7.811863559248197e-02, -3.012432892762715e-01, -7.773807325735529e-01, 8.267661952366478e+00) polyv <- polyval(p, Re(x)) # series expansion k <- which(abs(Im(x)) <= polyv) if (length(k) != 0) { # initialization egamma <- 0.57721566490153286061 xk <- x[k] yk <- -egamma - log(xk +0i) j <- 1 pterm <- xk term <- xk while (any(abs(term) > eps)) { yk <- yk + term j <- j + 1 pterm <- -xk * pterm / j term <- pterm / j } y[k] <- yk } # continued fraction k <- which( abs(Im(x)) > polyv ) if (length(k) != 0) { m <- 1 # we're calculating E1(x) # initialization xk <- x[k] nk <- length(xk) am2 <- numeric(nk) bm2 <- rep(1, nk) am1 <- rep(1, nk) bm1 <- xk; f <- am1 / bm1 oldf <- rep(Inf, nk) j <- 2 while (any(abs(f - oldf) > (100 * eps) * abs(f))) { alpha <- m - 1 + (j/2) # calculate the recursion coefficients a <- am1 + alpha * am2 b <- bm1 + alpha * bm2 # save new normalized variables for next pass am2 <- am1 / b bm2 <- bm1 / b am1 <- a / b bm1 <- 1 f <- am1 j <- j + 1 # calculate the coefficients for j odd alpha <- (j-1)/2 beta <- xk a <- beta * am1 + alpha * am2 b <- beta * bm1 + alpha * bm2 am2 <- am1 / b bm2 <- bm1 / b am1 <- a / b bm1 <- 1 oldf <- f f <- am1 j <- j+1 } y[k] <- exp(-xk) * f - 1i * pi * ((Re(xk) < 0) & (Im(xk) == 0)) } if (all(Im(y) == 0)) y <- Re(y) return(y) } expint_E1 <- expint # E1() expint_Ei <- function(x) { # Ei() stopifnot(is.numeric(x) || is.complex(x)) # y <- -expint(-x) + sign(Im(x)) * pi * 1i y <- ifelse(sign(Im(x)) <= 0, -expint(-x) - pi*1i, -expint(-x) + pi*1i) if (all(Im(y) == 0)) y <- Re(y) return(y) } li <- function(x) { stopifnot(is.numeric(x) || is.complex(x)) y <- expint_Ei(log(x + 0i)) if (all(Im(y) == 0)) y <- Re(y) return(y) } pracma/R/whittaker.R0000644000176200001440000000172513034767277014070 0ustar liggesusers## ## w h i t t a k e r . R Whittaker Smoothing ## whittaker <- function(y, lambda = 1600, d = 2){ # Smoothing with a finite difference penalty # y: signal to be smoothed # lambda: smoothing parameter (rough 50..1e4 smooth) # d: order of differences in penalty (generally 2) m <- length(y) E <- eye(m) D <- diff(E, lag = 1, differences = d) B <- E + (lambda * t(D) %*% D) z <- solve(B, y) return(z) } # whittaker <- function(y, lambda = 1600, d = 2) { # stopifnot(is.numeric(y)) # success <- library("SparseM", pos = "package:base", # logical.return = TRUE, warn.conflicts = FALSE) # if (!success) # stop("Function 'whittaker' requires package 'SparseM'.") # # m <- length(y) # E <- as(m, "matrix.diag.csr") # class(E) <- "matrix.csr" # # Dmat <- diff(E, differences = d) # B <- E + (lambda * t(Dmat) %*% Dmat) # z <- solve(B, y) # # return(z) # } pracma/R/ppfit.R0000644000176200001440000000160112001565513013157 0ustar liggesusers## ## p p f i t . R Piecewise Polynomial Fit ## ppfit <- function(x, y, xi, method = c("linear", "cubic")) { stopifnot(is.numeric(x), is.numeric(y), is.numeric(xi)) if (length(x) != length(y) || length(x) <= 1) stop("Length of 'x' and 'y' must be equal and greater than 1.") method <- match.arg(method) y0 <- interp1(x, y, xi, method = method) nn <- finds(x >= xi[1] & x <= xi[length(xi)]) fcn <- function(yi) sum((interp1 (xi, yi, x[nn], method) - y[nn])^2) yi <- optim(y0, fcn)$par n <- length(xi) - 1 if (method == "linear") { P <- matrix(NA, nrow = n, ncol = 2) for (i in 1:n) P[i, ] <- c((yi[i+1]-yi[i])/(xi[i+1]-xi[i]), yi[i]) pp <- mkpp(xi, P) } else if (method == "cubic") { pp <- cubicspline(xi, yi) } else stop("Unknown method: must be 'linear' or 'cubic'.") return(pp) } pracma/R/quadgk.R0000644000176200001440000000454111601347707013327 0ustar liggesusers## ## g a u s s g k . R Adapitve Gauss-Kronrod ## quadgk <- function(f, a, b, tol = .Machine$double.eps^0.5, ...) { stopifnot(is.numeric(a), length(a) == 1, is.numeric(b), length(b) == 1) eps <- .Machine$double.eps fun <- match.fun(f) f <- function(x) fun(x, ...) if (a == b) return(0) else if (a > b) return(-1 * quadgk(f, b, a, tol = tol)) # Nodes and weights for Gauss-Kronrod (7, 15) n15 <- c(-0.9914553711208126, -0.9491079123427585, -0.8648644233597691, -0.7415311855993944, -0.5860872354676911, -0.4058451513773972, -0.2077849550078985, 0.0, 0.2077849550078985, 0.4058451513773972, 0.5860872354676911, 0.7415311855993944, 0.8648644233597691, 0.9491079123427585, 0.9914553711208126) n7 <- c(-0.9491079123427585, -0.7415311855993944, -0.4058451513773972, 0.0, 0.4058451513773972, 0.7415311855993944, 0.9491079123427585) w15 <- c(0.02293532201052922, 0.06309209262997855, 0.1047900103222502, 0.1406532597155259, 0.1690047266392679, 0.1903505780647854, 0.2044329400752989, 0.2094821410847278, 0.2044329400752989, 0.1903505780647854, 0.1690047266392679, 0.1406532597155259, 0.1047900103222502, 0.06309209262997855, 0.02293532201052922) w7 <- c(0.1294849661688697, 0.2797053914892767, 0.3818300505051189, 0.4179591836734694, 0.3818300505051189, 0.2797053914892767, 0.1294849661688697) .gkadpt <- function(f, a, b, tol = tol) { # use nodes and weights from the environment x15 <- 0.5 * ((b - a) * n15 + b + a) x7 <- 0.5 * ((b - a) * n7 + b + a) Q7 <- sum(w7 * f(x7)) * (b-a)/2 Q15 <- sum(w15 * f(x15)) * (b-a)/2 if (!is.finite(Q7) || !is.finite(Q15)) { warning("Infinite or NA function value encountered.") return(Q15) } else if (abs(Q15 - Q7) < tol) { return(Q15) } else if (abs(b-a) < 16*eps) { warning("Minimum step size reached; singularity possible.") return(Q2) } # else Q2 <- .gkadpt(f, (a+b)/2, b, tol = tol) Q1 <- .gkadpt(f, a, (a+b)/2, tol = tol) return(Q1 + Q2) } # start the recursive procedure .gkadpt(f, a, b, tol = tol) } pracma/R/fact.R0000644000176200001440000000204012542771664012770 0ustar liggesusers## ## f a c t . R Factorial Function ## fact <- function(n) { if (!is.numeric(n)) stop("Argument 'n' must be a numeric vector or matrix.") d <- dim(n) n <- c(n) n <- floor(n) f <- rep(1, length(n)) i0 <- which(n > 170) if (length(i0) > 0) f[i0] <- Inf i1 <- which(n < 0) if (length(i1) > 0) f[i1] <- NaN i2 <- which(is.na(n)) if (length(i2) > 0) f[i2] <- NA ii <- which(n > 0 & n <= 170) if (length(ii) > 0) { nn <- n[ii] ff <- numeric(length(nn)) s = 1 for (k in 1:max(nn)) { s <- s * k p <- which(nn == k) ff[p] <- s } f[ii] <- ff } dim(f) <- d return(f) } factorial2 <- function(n) { stopifnot(is.numeric(n) || length(n) > 1) n = floor(n) if (n > 170) return(Inf) if (n < 0) return(NaN) if (n == 0) return(1) if (n %% 2 == 0) { return( prod(seq(from = 2, to = n, by = 2)) ) } else { return( prod(seq(from = 1, to = n, by = 2)) ) } } pracma/R/poisson2disk.R0000644000176200001440000000150013231236405014463 0ustar liggesusers## ## p o i s s o n 2 d i s k . R ## poisson2disk <- function(n, a = 1, b = 1, m = 10, info = TRUE) { if (a <= 0 || b <= 0) stop("Width a and height b must be positive reals.") if (floor(n) != ceiling(n) || n < 1 || floor(m) != ceiling(m) || m < 1) stop("n and m must be integer numbers.") ab <- rep(c(a, b), times = c(m, m)) A <- matrix(0, n, 2) A[1, ] <- c(a, b) * runif(2) i <- 2 while (i <= n) { B <- matrix( ab * runif(2*m), nrow = m, ncol = 2) C <- distmat(B, A[1:(i-1), ]) k <- which.max(apply(C, 1, min)) A[i, ] <- B[k, ] i <- i + 1 } if (info) { AA <- distmat(A, A) diag(AA) <- max(AA) d <- sqrt(2*a*b / n) cat("Minimal Distance between points: ", min(AA), '\n') } return(A) } pracma/R/golden_ratio.R0000644000176200001440000000146211546666270014527 0ustar liggesusers## ## g o l d e n _ r a t i o .R Golden Ratio Search ## golden_ratio <- function(f, a, b, ..., maxiter = 100, tol = .Machine$double.eps^0.5) # Golden Ratio search for a univariate function minimum in a bounded interval { fun <- match.fun(f) f <- function(x) fun(x, ...) phi <- 1 - (sqrt(5) - 1)/2 x <- c(a, a + phi*(b-a), b - phi*(b-a), b) y2 <- f(x[2]) y3 <- f(x[3]) n <- 0 while (x[3] - x[2] > tol) { n <- n + 1 if (y3 > y2) { x <- c(x[1], x[1]+phi*(x[3]-x[1]), x[2], x[3]) y3 <- y2 y2 <- f(x[2]) } else { x <- c(x[2], x[3], x[4]-phi*(x[4]-x[2]), x[4]) y2 <- y3 y3 <- f(x[3]) } if (n >= maxiter) break } xm <- (x[2]+x[3])/2 fxm <- if (abs(f(xm)) <= tol^2) 0.0 else f(xm) return(list(xmin=xm, fmin=fxm, iter=n, estim.prec=abs(x[3]-x[2]))) } pracma/R/std.R0000644000176200001440000000070711566455115012650 0ustar liggesusers## ## s t d . R ## std <- function(x, flag=0) { if (length(x) == 0) return(c()) if (!is.numeric(x)) stop("Argument 'x' must be a numeric vector or matrix.") n <- if (flag == 0) length(x) - 1 else length(x) sqrt(sum((x-mean(x))*(x-mean(x)))/n) } std_err <- function(x) { if (length(x) == 0) return(c()) if (!is.numeric(x)) stop("Argument 'x' must be a numeric vector or matrix.") sqrt(var(x)/length(x)) } pracma/R/anms.R0000644000176200001440000000576413233712754013022 0ustar liggesusersanms <- function(fn, x0, ..., tol = 1e-10, maxfeval = NULL) { stopifnot(is.numeric(x0) && length(x0) > 1) d <- length(x0); d1 <- d + 1 fun <- match.fun(fn) fn <- function(x) fun(x, ...) if (is.null(maxfeval)) maxfeval <- 50 * d^2 # set up adaptive parameters alpha <- 1; beta <- 1 + 2/d gamma <- 0.75 - 0.5/d; delta <- 1 - 1/d # large initial simplex is used scalefactor <- min(max(max(abs(x0)), 1), 10) # construct the initial simplex D0 <- rbind(eye(d), (1-sqrt(d1)) / d * ones(1,d)) X <- matrix(0, nrow = d1, ncol = d) FX <- numeric(d1) for (i in 1:d1) { X[i, ] <- x0 + scalefactor * D0[i, ] FX[i] <- fn(X[i, ]) } o <-order(FX, decreasing = FALSE) FX <- FX[o]; X <- X[o, ] # main iteration ct <- d1 while (max(abs(X[2:d1, ] - X[1:d, ])) >= scalefactor*tol) { if (ct > maxfeval) break M <- apply(X[1:d, ], 2, mean) xref <- (1+alpha) * M - alpha * X[d1, ] Fref <- fn(xref) ct <- ct + 1 if (Fref < FX[1]) { # expansion xexp <- (1+alpha*beta) * M - alpha*beta*X[d1, ] Fexp <- fn(xexp) ct <- ct+1 if (Fexp < Fref) { X[d1, ] <- xexp FX[d1] <- Fexp } else { X[d1, ] <- xref FX[d1] <- Fref } } else { if (Fref < FX[d]) { # accept reflection point X[d1, ] <- xref FX[d1] <- Fref } else { if (Fref < FX[d1]) { # Outside contraction xoc <- (1+alpha*gamma) * M - alpha*gamma*X[d1, ] Foc <- fn(xoc) ct <- ct+1; if (Foc <= Fref) { X[d1, ] <- xoc FX[d1] <- Foc } else { # shrink for (i in 2:d1) { X[i, ] <- X[1, ] + delta*(X[i, ] - X[1, ]) FX[i] <- fn(X[i, ]) } ct=ct+d } } else { # inside contraction xic <- (1-gamma) * M + gamma*X[d1, ] Fic <- fn(xic) ct <- ct+1 if (Fic < FX[d1]) { X[d1, ] <- xic FX[d1] <- Fic } else { # shrink for (i in 2:d1) { X[i, ] <- X[1, ] + delta*(X[i, ] - X[1, ]) FX[i] <- fn(X[i, ]) } ct <- ct+d } } } } o <-order(FX, decreasing = FALSE) FX <- FX[o]; X <- X[o, ] } xmin <- X[1, ] fmin <- FX[1] return(list(xmin = xmin, fmin = fmin, nfeval = ct)) }pracma/R/bits.R0000644000176200001440000000210712367744414013016 0ustar liggesusersbits <- function(x, k = 54, pos_sign = FALSE, break0 = FALSE) { stopifnot(is.numeric(x), length(x) == 1) if (ceiling(k) != floor(k) || k <= 0) stop("Argument 'k' must be a (positive) integer.") if (x >= 0) { b <- if (pos_sign) "+" else "" } else { b <- "-" x <- -x } xn <- trunc(x) xf <- x - xn if (xn >= 1) { m2 <- nextpow2(xn) if (2^m2 > xn) m2 <- m2 - 1 for (i in seq(m2, 0, by=-1)) { s <- 2^i if (xn >= s) { b <- paste(b, "1", sep="") xn <- xn - s } else b <- paste(b, "0", sep="") } } else { b <- paste(b, "0", sep="") } if (xf > 0) { b <- paste(b, ".", sep="") for (i in 1:k) { s <- 1/2^i if (xf >= s) { b <- paste(b, "1", sep="") xf <- xf - s if (break0 && xf == 0) break } else b <- paste(b, "0", sep="") } } return(b) } pracma/R/grad.R0000644000176200001440000000234512101433324012753 0ustar liggesusers## ## g r a d . R Function Gradient ## grad <- function(f, x0, heps = .Machine$double.eps^(1/3), ...) { if (!is.numeric(x0)) stop("Argument 'x0' must be a numeric value.") fun <- match.fun(f) f <- function(x) fun(x, ...) if (length(f(x0)) != 1) stop("Function 'f' must be a univariate function of 2 variables.") n <- length(x0) hh <- rep(0, n) gr <- numeric(n) for (i in 1:n) { hh[i] <- heps gr[i] <- (f(x0 + hh) - f(x0 - hh)) / (2*heps) # gr[i] <- (-f(x0+2*hh)+8*f(x0+hh)-8*f(x0-hh)+f(x0-2*hh))/(12*h) hh[i] <- 0 } return(gr) } # Compute the Jacobian as J_{ij} = df_i/dx_j for a vector-valued function # w/o assuming that the f_i are vectorized. jacobian <- function(f, x0, heps = .Machine$double.eps^(1/3), ...) { if (!is.numeric(x0) || length(x0) == 0) stop("Argument 'x' must be a non-empty numeric vector.") fun <- match.fun(f) f <- function(x) fun(x, ...) n <- length(x0) m <- length(f(x0)) jacob <- matrix(NA, m, n) hh <- numeric(n) for (i in 1:n) { hh[i] <- heps jacob[, i] <- (f(x0 + hh) - f(x0 - hh)) / (2*heps) # jacob[, i] <- (-f(x+2*h)+8*f(x+h)-8*f(x-h)+f(x-2*h))/(12*h.eps) hh[i] <- 0 } return(jacob) } pracma/R/fminunc.R0000644000176200001440000001131213400317701013472 0ustar liggesusers## ## f m i n u n c . R Unconstrained Minimization ## # o Added 'fminunc()' for unconstrained function minimization, based # on a 'variable metric' approach by John Nash (see package Rvmmin). #' Minimization of unconstrained multivariable functions fminunc <- function(x0, fn, gr = NULL, ..., tol = 1e-08, maxiter = 0, maxfeval = 0) { if (!is.numeric(x0) || length(x0) <= 1) stop("Argument 'x0' must be a vector of length greater than 1.") fun <- match.fun(fn) fn <- function(x) fun(x, ...) if (is.null(gr)) gr <- function(x) pracma::grad(fn, x) sol <- .varmetric(x0, fn, gr, tol = tol, maxiter = maxiter, maxfeval = maxfeval) return(sol) } .varmetric <- function(par, fn, gr, tol = 1e-08, maxiter = 0, maxfeval = 0) { # Prepare control parameters n <- length(par) if (maxiter == 0) maxiter <- 1000 + 5 * n if (maxfeval == 0) maxfeval <- 3000 + 10 * n maxit <- maxiter eps <- tol acctol <- 0.0001 dowarn <- FALSE stepredn <- 0.2 offset <- 100.0 stopbadupdate <- TRUE ceps <- .Machine$double.eps * offset dblmax <- .Machine$double.xmax # used to flag bad function # Set working parameters keepgoing <- TRUE ifn <- ig <- 1 # count function evaluations ilast <- ig bvec <- par; f <- fn(bvec) fmin <- f; g <- gr(bvec) oldstep <- 1 msg <- "Status not resolved" conv <- -1 gnorm <- sqrt(sum(g*g)) if (gnorm < (1 + abs(fmin))*eps*eps ) { keepgoing <- FALSE msg <- "Small gradient norm" conv <- 2 } while (keepgoing) { ## main loop if (ilast == ig) B <- diag(1, n, n) fmin <- f par <- bvec c <- g t <- as.vector(-B %*% g) # compute search direction gradproj <- sum(t * g) # gradient projection accpoint <- FALSE if (gradproj <= 0) { changed <- TRUE steplength <- oldstep while ((f >= fmin) && changed && (!accpoint)) { bvec <- par + steplength * t changed <- (!identical((bvec + offset), (par + offset)) ) if (changed) { f <- fn(bvec) ifn <- ifn + 1 if (ifn > maxfeval) { msg <- "Too many function evaluations" if (dowarn) warning(msg) conv <- 1 changed <- FALSE keepgoing <- FALSE break } if (f < fmin) { accpoint <- (f <= fmin + gradproj * steplength * acctol) } else { steplength <- steplength * stepredn } } } } if (accpoint) { fmin <- f g <- gr(bvec) ig <- ig + 1 if (ig > maxit) { keepgoing = FALSE msg = "Too many gradient evaluations" if (dowarn) warning(msg) conv <- 1 break } par <- bvec gnorm <- sqrt(sum(g*g)) if (gnorm < (1 + abs(fmin))*eps*eps ) { keepgoing <- FALSE msg <- "Small gradient norm" conv <- 2 break } t <- as.vector(steplength * t) c <- as.vector(g - c) D1 <- sum(t * c) if (D1 > 0) { y <- as.vector(crossprod(B, c)) D2 <- as.double(1+crossprod(c,y)/D1) B <- B - (outer(t, y) + outer(y, t) - D2 * outer(t, t))/D1 } else { if (ig == ilast+1) { if (stopbadupdate && ! accpoint) keepgoing=FALSE msg <- paste("UPDATE NOT POSSIBLE: ilast, ig", ilast, ig, sep = "") conv <- 3 } ilast <- ig } } else { if ( (ig == ilast) || (abs(gradproj) < (1 + abs(fmin))*eps*eps ) ) { # we reset to gradient and did new linesearch keepgoing <- FALSE # no progress possible if (conv < 0) { # conv == -1 is used to indicate it is not set conv <- 0 } msg <- "Rvmminu converged" } else { ilast <- ig } } } # end main loop counts <- c("function" = ifn, "gradient" = ig) ans <- list(par = par, value = fmin, counts = counts, convergence = conv, message = msg) return(ans) } pracma/R/hypot.R0000644000176200001440000000164513574516673013233 0ustar liggesusers## ## h y p o t h . R ## hypot <- function(x, y) { if ((length(x) == 0 && is.numeric(y) && length(y) <= 1) || (length(y) == 0 && is.numeric(x) && length(x) <= 1)) return(c()) if (!is.numeric(x) && !is.complex(x) || !is.numeric(y) && !is.complex(y)) stop("Arguments 'x' and 'y' must be numeric or complex.") if (length(x) == 1 && length(y) > 1) { x <- rep(x, length(y)); dim(x) <- dim(y) } else if (length(x) > 1 && length(y) == 1) { y <- rep(y, length(x)); dim(y) <- dim(x) } if ((is.vector(x) && is.vector(y) && length(x) != length(y)) || (is.matrix(x) && is.matrix(y) && dim(x) != dim(y)) || (is.vector(x) && is.matrix(y)) || is.matrix(x) && is.vector(y)) stop("Arguments 'x' and 'y' must be of the same size.") x <- abs(x); y <- abs(y) m <- pmin(x, y); M <- pmax(x, y) ifelse(M == 0, 0, M * sqrt(1 + (m / M)^2)) } pracma/R/hurst.R0000644000176200001440000000634513046056573013227 0ustar liggesusers## ## h u r s t . R Hurst Exponent ## .hurstrs <- function(x) { # half intervals of indices half <- function(N) sort(c(N, N[-length(N)]+((diff(N)+1)%/%2))) # define the R/S scale rscalc <- function(x) { n <- length(x); y <- cumsum(x - mean(x)) R <- diff(range(y)); S <- sd(x) return(R/S) } # set initial values X <- c(length(x)) Y <- c(rscalc(x)) N <- c(0, length(x) %/% 2, length(x)) # compute averaged R/S for halved intervals while ( min(diff(N)) >= 8 ) { xl <- c(); yl <- c() for (i in 2:length(N)) { rs <- rscalc(x[(N[i-1]+1):N[i]]) xl <- c(xl, N[i]-N[i-1]) yl <- c(yl, rs) } X <- c(X, mean(xl)) Y <- c(Y, mean(yl)) # next step N <- half(N) } # apply linear regression rs_lm <- lm(log(Y) ~ log(X)) return(unname(coefficients(rs_lm)[2])) } hurstexp <- function(x, d = 50, display = TRUE) { stopifnot(is.numeric(x), is.numeric(d)) d <- max(2, floor(d[1])) N <- length(x) if (N %% 2 != 0) { x <- c(x, (x[N-1] + x[N])/2) N <- N + 1 } # Calculate simple R/S rssimple <- function(x){ n <- length(x) y <- x - mean(x) s <- cumsum(y) rs <- (max(s) - min(s)) / sd(x) log(rs) / log(n) } # Calculate empirical R/S rscalc <- function(z, n) { m <- length(z)/n y <- matrix(x, n, m) e <- apply(y, 2, mean) s <- apply(y, 2, std) for (i in 1:m) y[, i] <- y[, i] - e[i] y <- apply(y, 2, cumsum) mm <- apply(y, 2, max) - apply(y, 2, min) return( mean(mm/s) ) } divisors <- function(n, n0 = 2) { n0n <- n0:floor(n/2) dvs <- n0n[n %% n0n == 0] return(dvs) } # Find the optimal vector d N <- length(x); dmin <- d N0 <- min(floor(0.99 * N), N-1) N1 <- N0; dv <- divisors(N1, dmin) for (i in (N0+1):N) { dw <- divisors(i, dmin) if (length(dw) > length(dv)) {N1 <- i; dv <- dw} } OptN <- N1; d <- dv x <- x[1:OptN] N <- length(d) RSe <- ERS <- numeric(N) for (i in 1:N) RSe[i] <- rscalc(x, d[i]) # Compute corrected theoretical E(R/S) for (i in 1:N) { n <- d[i] K <- c((n-1):1)/c(1:(n-1)) ratio <- (n-0.5)/n * sum(sqrt(K)) if (n > 340) ERS[i] <- ratio/sqrt(0.5*pi*n) else ERS[i] <- (gamma(0.5*(n-1))*ratio) / (gamma(0.5*n)*sqrt(pi)) } # Compute the Hurst exponent as the slope on a loglog scale ERSal <- sqrt(0.5*pi*d) Pal <- polyfit(log10(d), log10(RSe - ERS + ERSal), 1) Hal <- Pal[1] # Calculate the empirical and theoretical Hurst exponents Pe <- polyfit(log10(d), log10(RSe), 1) He <- Pe[1] P <- polyfit(log10(d), log10(ERS), 1) Ht <- P[1] Hs <- rssimple(x) Hrs <- .hurstrs(x) if (display) { cat("Simple R/S Hurst estimation: ", Hs, "\n") cat("Corrected R over S Hurst exponent: ", Hrs, "\n") cat("Empirical Hurst exponent: ", He, "\n") cat("Corrected empirical Hurst exponent: ", Hal, "\n") cat("Theoretical Hurst exponent: ", Ht, "\n") invisible(list(Hs = Hs, Hrs = Hrs, He = He, Hal = Hal, Ht = Ht)) } else { return(list(Hs = Hs, Hrs = Hrs, He = He, Hal = Hal, Ht = Ht)) } } pracma/R/fderiv.R0000644000176200001440000000477112105737273013340 0ustar liggesusers## ## f d e r i v . R Numerical Differentiation ## fderiv <- function(f, x, n = 1, h = 0, method = c("central", "forward", "backward"), ...) { if (length(x) == 0) return(c()) if (!is.numeric(x)) stop("Argument 'x' must be a number or a numeric vector.") n <- floor(n) if (n < 0) stop("The order of the derivative, 'n', can only be between 0 and 8.") if (n > 8) warning("Numerical derivatives of order 'n > 8' will be very inexact.") method <- match.arg(method) fun <- match.fun(f) f <- function(x) fun(x, ...) fx <- f(x) if (length(fx) != length(x)) stop("Function 'f' must first be vectorized: Vectorize(f).") if (n == 0) return(f(x)) if (h == 0) { h <- .Machine$double.eps^(1/(n+2)) } if (method == "central") { if (n == 1) { .df <- (f(x+h) - f(x-h)) / (2*h) } else if (n == 2) { .df <- (f(x+h) - 2*f(x) + f(x-h)) / h^2 } else if (n == 3) { .df <- (f(x+2*h) - 2*f(x+h) + 2*f(x-h) - f(x-2*h)) / (2*h^3) } else if (n == 4) { .df <- (f(x+2*h) - 4*f(x+h) + 6*f(x) - 4*f(x-h) + f(x-2*h)) / h^4 } else { .df <- sum((-1)^(0:n) * choose(n, 0:n) * f(((n/2):(-n/2))*h))/h^n } } else if (method == "forward") { if (n == 1) { .df <- (-f(x+2*h) + 4*f(x+h) - 3*f(x)) / (2*h) } else if (n == 2) { .df <- (-f(x+3*h) + 4*f(x+2*h) - 5*f(x+h) + 2*f(x)) / h^2 } else if (n == 3) { .df <- (-3*f(x+4*h) + 14*f(x+3*h) - 24*f(x+2*h) + 18*f(x+h) - 5*f(x)) / (2*h^3) } else if (n == 4) { .df <- (-2*f(x+5*h) + 11*f(x+4*h) - 24*f(x+3*h) + 26*f(x+2*h) - 14*f(x+h) + 3*f(x)) / h^4 } else { .df <- sum((-1)^(0:n) * choose(n, 0:n) * f((n:0)*h))/h^n } } else if (method == "backward") { if (n == 1) { .df <- (3*f(x) - 4*f(x-h) + f(x-2*h)) / (2*h) } else if (n == 2) { .df <- (2*f(x) - 5*f(x-h) + 4*f(x-2*h) - f(x-3*h)) / h^2 } else if (n == 3) { .df <- (5*f(x) - 18*f(x-h) + 24*f(x-2*h) - 14*f(x-3*h) + 3*f(x-4*h)) / (2*h^3) } else if (n == 4) { .df <- (3*f(x) - 14*f(x-h) + 26*f(x-2*h) - 24*f(x-3*h) + 11*f(x-4*h) - 2*f(x-5*h)) / h^4 } else { .df <- sum((-1)^(0:n) * choose(n, 0:n) * f((0:-n)*h))/h^n } } else stop("Unknown 'method'; use 'central', 'forward' or 'backward' instead.") return(.df) } pracma/R/cross.R0000755000176200001440000000241111605773325013204 0ustar liggesusers### ### CROSS.R Vector product ### cross <- function(x, y) { if (!is.numeric(x) || !is.numeric(y)) stop("Arguments 'x' and 'y' must be numeric vectors or matrices.") if (is.vector(x) && is.vector(y)) { if (length(x) == length(y) && length(x) == 3) { xxy <- c(x[2]*y[3] - x[3]*y[2], x[3]*y[1] - x[1]*y[3], x[1]*y[2] - x[2]*y[1]) } else { stop("Vectors 'x' and 'y' must be both of length 3.") } } else { if (is.matrix(x) && is.matrix(y)) { if (all(dim(x) == dim(y))) { if (ncol(x) == 3) { xxy <- cbind(x[, 2]*y[, 3] - x[, 3]*y[, 2], x[, 3]*y[, 1] - x[, 1]*y[, 3], x[,1 ]*y[, 2] - x[, 2]*y[, 1]) } else { if (nrow(x) == 3) { xxy <- rbind(x[2, ]*y[3, ] - x[3, ]*y[2, ], x[3, ]*y[1, ] - x[1, ]*y[3, ], x[1, ]*y[2, ] - x[2, ]*y[1, ]) } else { stop("'x', 'y' must have one dimension of length 3.") } } } else { stop("Matrices 'x' and 'y' must be of same size.") } } else { if (is.vector(x) && is.matrix(y) || is.matrix(x) && is.vector(y)) { stop("Arguments 'x', 'y' must be vectors/matrices of same size.") } } } return(xxy) } pracma/NEWS.md0000644000176200001440000012561114153353526012630 0ustar liggesusers# pracma NEWS ## pracma 2.3.6 (2021-12-03) * Corrected randortho() with return value 'q %*% diag(ph) # %*% q', as researched and reported by Daniel Kessler; thanks a lot. * Function deeve() requires the x-coordinates to be sorted. * Removed the Nile data (without warning). ## pracma 2.3.5 (2021-07-10) * Corrected a bug in subspace() - thanks to David Fleischer. * Corrected a small but annoying bug in steep_descent(). * Allows for complex matrices in pinv() (and mldivide()). ## pracma 2.3.4 (2021-03-18) * Small correction in 'movavg()': default type now is 's'. ## pracma 2.3.3 (2021-01-22) * Forgot to correct URL addresses in the Readme.md file. ## pracma 2.3.2 (2021-01-16) * Removed and corrected URL addresses from 'http' to 'https'. ## pracma 2.3.1 (2021-01-13) * 'ellipke' help page: compute circumference of an ellipse. * 'Mode()' now handling all types of NAs (thx. Michael Henry). ## pracma 2.3.0 (2020-04-09) * circlefit(): option 'fast' is deprecated and will not be used. * gammainc(0, a) returns 0, thanks to Mark Chappell for reporting. * ndims() now returns 1 for vectors and 0 for empty objects. ## pracma 2.2.9 (2019-12-15) * Changed URL reference of Abramowitz and Stegun (link missing). * Fixed warning with the 'try' construct in several functions using 'if(inherits(e, "try-error"))' (help from Bert Gunter). * Link to R Base HTML help page gave a warning (for Windows). ## pracma 2.2.8 (2019-07-09) * erfi() returns real values when the input values are all real. * hypot() now allows for scalar plus numeric vector as inputs. ## pracma 2.2.7 (2019-05-21) * Polynomial division with polydiv(); for two plynomials polygcf() finds the greatest common factor; and rootmult() returns the multiplicity of a polynomial root (or 0). * polyroots() refines the result of roots() in case of roots with multiplicities (where roots() is quite inaccurate). ## pracma 2.2.6 (2019-05-02) * All polynomial functions now accept complex coefficients, esp. roots() finds roots for complex polynomials. * Fixed a bug in laguerre() for zeros of complex polynomials. ## pracma 2.2.5 (2019-04-08) * fsolve() and broyden() are no longer applicable to univariate functions (Morrison-Sherman formula not working in this case). * Alias cgmin() and option 'dfree=F' in fminsearch() are removed, both have been deprecated since half a year. ## pracma 2.2.4 (2018-12-12) * qpsolve() minimizes quadratic forms such as 0.5*t(x)*x-d*x with linear quality and inequality constraints. * fmincon() now has an 'augmented Lagrangian' option with a 'variable metric' approach as inner solver. ## pracma 2.2.3 (2018-12-10) * linearproj() linear projection onto a linear subspace, and affineproj() linear projection onto an affine subspace of R^n. ## pracma 2.2.2 (2018-11-30) * Corrected "length > 1 in coercion to logical" in expm(). ## pracma 2.2.1 (2018-11-30) * fminunc() unconstrained minimization of nonlinear objective function, based on stripped-down 'Rvmmin' code by John Nash. * 'fmincon()' minimization of nonlinear objective function with constraints; wraps suggested package NlcOptim with SQP method. ## pracma 2.2.0 (2018-11-27) * Reintroduced 'nelder_mead()' and 'hooke_jeeves()'. * fminsearch() now calls 'Nelder-Mead' or 'Hooke-Jeeves', i.e., derivative-free methods only; 'dfree=F' gets deprecated. ## pracma 2.1.9 (2018-11-22) * Renamed 'cgmin()' to its original name 'fletcher_powell', alias 'cgmin' is deprecated since this version. * Removed alias 'normest2' that was anyway non-existing. ## pracma 2.1.8 (2018-10-16) * Corrected a bug in hessenberg() reported by Ben Ubah. ## pracma 2.1.7 (2018-09-24) * Removed the deprecated 'rortho' function, use randortho() instead. ## pracma 2.1.6 (2018-09-09) * Si(), Ci() sine and cosine integral functions added. * Added dot notation for brent(), bisect(), newton(), halley(), and ridders() -- on request of John Nash for the histRalg project. ## pracma 2.1.4 (2018-01-29) * shubert() implements one-dimensional Shubert-Piyavskii method. * fminsearch() and anms() stop for one-dimensional minimization. ## pracma 2.1.3 (2018-01-23) * bsxfun() now uses sweep() for matrices in search of higher speed. * direct1d() removed because slow and not effective. ## pracma 2.1.2 (2018-01-21) * poisson2disk() approximate Poisson disk distribution * Corrected small bug in findpeaks(), reported by Mike Badescu. ## pracma 2.1.1 (2017-11-21) * Added a field "Authors@R" in the DESCRIPTION, deleted others. * Added README.md and NEWS.md (for a future Github repository). * Needed a new version for resubmitting (because of 'survivalsvm') ## pracma 2.1.0 (2017-11-20) * Package 'quadprog' is now suggested, not imported; the functions quadprog() and lsqlincon() work only when 'quadprog' is installed. ## pracma 2.0.9 (2017-09-21) * Package byte-compiled on loading (Requires R version >= 3.1.0). ## pracma 2.0.8 (2017-09-20) * findpeaks() function not checking for NAs (reported by Wesley Burr). * fplot() extra parameters were not handed over to plotting routine. ## pracma 2.0.7 (2017-06-17) * bernstein() generates the Bernstein polynomial B_,_(). * legendre(n,_) corrected for n=0, thanks to Peter W. Marcy. * cgmin() alias for fletcher_powell(), a constraint gradient method. ## pracma 2.0.6 (2017-06-06) * polyvalm() evaluates a polynomial in the matrix sense. * arnoldi() Arnoldi iteration (incl. Hessenberg matrix). ## pracma 2.0.5 (2017-04-30) * integral() redesigned, less methods, several starting intervals with regular or random intermediate nodes (similar to MATLAB). * quadgr() corrected as functions vectorized with Vectorize() did not behave as expected with apply(); still needs vectorization. * Help page of quadgk() did not mention the need for vectorization. ## pracma 2.0.4 (2017-04-01) * hessenberg() computes the Hessenberg form of a matrix through Householder transformations (this is named hess() in MATLAB). ## pracma 2.0.3 (2017-03-23) * Corrected functions with conditions in control statements with conditions of length greater than one: rem(). ## pracma 2.0.2 (2017-02-23) * isposdef() test for positive definiteness of a (real) matrix. * hooke_jeeves() removed; similar implementations are available in packages 'dfoptim::hjk[b]' and 'adagio::hookejeeves'. ## pracma 2.0.1 (2017-02-06) * nelder_mead() replaced by an adaptive Nelder-Mead implementation, anms(), following F. Gao and L. Han. * fminsearch() now calls this new version of Nelder-Mead. ## pracma 2.0.0 (2017-01-26) * incgam(x,a) computes the incomplete upper gamma function using the R function pgamma for higher precision than gammainc(). * Corrected a small oversight in hurstexp(), thnx George Ostrouchov. ## pracma 1.9.9 (2017-01-10) * Slightly changed the description lines on request of CRAN. ## pracma 1.9.8 (2017-01-10) * whittaker() finally implemented avoiding the sparse matrix package. * nelder_mead() now applies adaptive parameters for the simplicial search, depending on the dimension of the problem space. * psinc(x,n), the so-called periodic sinc function. ## pracma 1.9.7 (2016-12-14) * shooting() implements the shooting method for boundary value problems of second order differential equations. * interp2() corrected the help page with size(z) = length(y)*length(x). * Corrected a small oversight on the help page of Gauss-Laguerre. ## pracma 1.9.6 (2016-09-11) * haversine() Haversine formula for geographical distances on earth. * trigonometric functions accepting degrees instead of inputs in radians: sind cosd tand cotd secd cscd asind acosd atand acotd asecd acscd atan2d ## pracma 1.9.5 (2016-09-06) * fprintf() mimicks MATLAB's function of the same name. * Added ezsurf(), an easy surface plot following MATLAB. * fplot() is almost an alias for ezplot(); please note that in future versions ez...() will be renamed to f...() according MATLAB 2016/17. ## pracma 1.9.4 (2016-07-27) * rortho() renamed to randortho(), the underlying code was buggy (not truely random) and has been replaced, thanks to Jan Tuitman. * an error in the final step of calculating approx_energy() was corrected, thanks to Daniel Krefl. ## pracma 1.9.3 (2016-05-28) * bvp() now solves boundary value problems for linear 2nd order ODEs using a 'finite differences' approach and a tridiagonal solver. * polyfit2() has been removed, use polyfix() instead. ## pracma 1.9.2 (2016-03-04) * romberg() corrected an error estimation that diminished the accuracy. * trapzfun() realizes trapezoidal integration with iterated calculations. ## pracma 1.9.1 (2016-02-15) * fractalcurve() generates some fractal curves of order n, i.e. the Hilbert, Sierpinski, Snowflake, Dragon, and Molecule curves. * ode23(), ode23s() changed the size of the returned components, now it is similar to what is returned by ode45() and ode78(). * arclength() corrected a boundary condition ('on the left'), added an example how to generate an arc-length parametrization of a curve. ## pracma 1.9.0 (2015-12-17) * quadprog() solves quadratic programming problems (QP) with linear equality and inequality constraints, based on package 'quadprog'. * lsqlincon() solves linear least-squares problems with linear equality and inequality constraints (as well as bound constraints). * pracma now imports package 'quadprog'. ## pracma 1.8.9 (2015-12-05) * polyfix() fits a polynomial that exactly passes through given fixed points. polyfit2() will be deprecated in future versions. * Important bug fix for polyApprox() (thanks to Max Marchi). ## pracma 1.8.8 (2015-10-28) * Option 'minpeakdistance' for function findpeaks() added (thanks to Razvan Chereji for providing a workable approach). ## pracma 1.8.7 (2015-07-20) * Removed invperm(). * 'linear' is now the default method for interp1(). * Cases n = 0, 1 for legendre() corrected (thanks to Nuzhdin Yury). ## pracma 1.8.6 (2015-07-11) * Removed two non-existing links pointing to Gander's pages at the ETHZ. * Removed a link explaining approximate entropy. ## pracma 1.8.5 (2015-07-07) * Added 'Imports' field in description and 'import' in namespace, as requested for the new R development version. * strrep() renamed to strRep(), because of a new function in R Base. ## pracma 1.8.4 (2015-06-25) * bernoulli() calculates the Bernoulli numbers and polynomials. * factorial2() the product of all even resp. odd integers below n. ## pracma 1.8.3 (2015-02-08) * Deleted some URLs that were not working properly anymore. ## pracma 1.8.2 (2015-02-07) * Special functions gathered under topics 'specfun' resp. 'specmat'. ## pracma 1.8.1 (2015-02-06) * sumalt() accelerating (infinite) alternating sums. * Option 'fast=FALSE' in circlefit() to avoid optim(). * Added Gauss' AGM-based computation of pi to agmean(). ## pracma 1.8.0 (2015-01-26) * hurstexp() amended for vectors of uneven length. ## pracma 1.7.9 (2014-11-15) * qpspecial() special quadratic programming solver. * Reintroduces the 'tol' keyword in fminbnd() for compatibility. ## pracma 1.7.8 (2014-11-10) * bulirsch_stoer() Bulirsch-Stoer method for solving *rdinary differential equations with high accuracy. * midpoint() implements the midpoint rule for solving ODEs combined with Richardson extrapolation for high accuracy. ## pracma 1.7.7 (2014-11-01) * lufact() LU factorization with partial pivoting; lusys() solves linear systems through Gaussian elimination. ## pracma 1.7.6 (2014-10-30) * ode23s() for stiff ordinary differential equations refining Rosenbrock's method (supply Jacobian if available). * euler_heun() Euler-Heun ODE solver has been corrected. ## pracma 1.7.5 (2014-10-20) * fminbnd() much improved implementation of Brent's method; added challenging example by Trefethen to the help page. * lambertWn() for the second (real) branch of Lambert W. * Function name alias cintegral() removed. ## pracma 1.7.4 (2014-10-13) * hooke_jeeves() replaced by a much more efficient implementation and equipped with a special approach to bound constraints. * nelder_mead() replaced by a much more efficient implementation and utilizing a transformation to handle bound constraints; functions nelmin() and nelminb() are not exported anymore. ## pracma 1.7.3 (2014-10-11) * quadinf() now uses the double exponential method with the tanh-sinh quadrature scheme for (semi-)infinite intervals. * Removed the not-exported and too slow .quadcc() function. * brent() alias for brentDekker(), newton() for newtonRaphson(). ## pracma 1.7.2 (2014-09-08) * pchipfun() function wrapper around pchip(); missing error handling in pchip() was added. * hurst() removed, functionality merged with hurstexp(). * Nile overflow data set 1871--1984 added as time series. ## pracma 1.7.1 (2014-08-12) * bits() binary representation of a number as string. * agmean() returns AGM, no of iterations, and estimated precision. * trapz() tiny improvement on error handling. ## pracma 1.7.0 (2014-06-30) * ode45() ODE solver using Dormand-Prince (4,5) coefficients. * ode78() ODE solver using Fehlberg (7,8) coefficients. * cintegral() renamed to line_integral(). ## pracma 1.6.9 (2014-06-14) * Version 1.6.8 "Failed to build" on R-Forge. [Maybe it's time to move pracma to a github repository.] ## pracma 1.6.8 (2014-06-07) * nelmin() a more efficient and accurate version of Nelder-Mead. * nelminb() Nelder-Mead in bounded regions (applies a transformation). ## pracma 1.6.7 (2014-05-23) * trisolve() stopping for singular tridiagonal matrices. * romberg() slightly improved accuracy and speed. ## pracma 1.6.6 (2014-04-12) * Corrected rref() (as pointed out by Peter Audano). ## pracma 1.6.5 (2014-02-24) * lsqnonneg() changed to an active-set approach. * bisect() trimmed bisection to return almost exact results. ## pracma 1.6.4 (2014-02-05) * halley() Halley's variant of the Newton-Raphson method. * numderiv() corrected Richardson's method by breaking the loop. ## pracma 1.6.3 (2014-01-25) * lambertWp() improved inner accuracy from 1e-12 to 1e-15. * complexstepJ() renamed to jacobian_csd(); introduced grad_csd(). * hessian_csd() applies Richardson's method as the second step, and the same for laplacian_csd(). ## pracma 1.6.2 (2014-01-19) * Removed zeroin(); for fzero() a variation of Brent-Dekker is used, that applies cubic instead of quadratic interpolation. * Corrected an oversight in newtonRaphson(). * brentDekker() returns a list now. ## pracma 1.6.1 (2014-01-14) * samp_entropy() complements approx_entropy() for short time series. * Removed NEWS.Rd and NEWS.pdf in favour of NEWS. ## pracma 1.6.0 (2013-12-06) * integral3() now handles functions as inner interval limits. * poly_crossings() calculates crossing points of two polygons. * erfz() complex error function vectorized (thanks to Michael Lachmann). ## pracma 1.5.9 (2013-11-30) * muller() implements Muller's root-finding method [Mueller, 1956], especially suited for polynomials and complex functions. * Inserted a safeguard for the distmat() function to prevent different results on Mac OS X, (Ubuntu) Linux, and Windows operating systems. * Removed pltcross() and kmeanspp(). ## pracma 1.5.8 (2013-11-28) * interp1() with option method ``spline'' now computes Moler's spline functions, for compatibility with MATLAB (hint by Boudewijn Klijn). ## pracma 1.5.7 (2013-10-11) * Corrected parameter 'waypoints' in cintegral(). ## pracma 1.5.6 (2013-09-22) * odregress() orthogonal distance (or: total least-squares) regression. * Changed maintainer name to its long form (CRAN request). ## pracma 1.5.5 (2013-09-11) * L1linreg() L1 (a.k.a. LAD or median) linear regression. * geo_median() geometric median (minimizes sum of distances). ## pracma 1.5.4 (2013-08-31) * rectint() rectangular intersection areas (MATLAB style). * cumtrapz() cumulative trapezoidal integration (MATLAB style). * Some corrections to help pages and function names. ## pracma 1.5.3 (2013-08-25) * arclength() length of a parametrized curve in n-dimensional space, w/ improved convergence by applying Richardson's extrapolation method. * legendre() associated Legendre functions (MATLAB style). ## pracma 1.5.2 (2013-08-23) * poly_center() calculates the center coordinates of a polygon. * poly_length() calculates the (euclidean) length of a polygon. * polyarea() corrected, returns the true, not the absolute value. ## pracma 1.5.1 (2013-08-19) * fsolve() will use broyden() if m = n; fzsolve() the same; additionally, improved broyden() and gaussNewton(). * ezplot() can draw markers on the line, with equal distances measured along the curve length. ## pracma 1.5.0 (2013-08-08) * gmres() generalized minimum residual method. * nearest_spd() finds nearest symmetric positive-definite matrix. * eps() floating point relative accuracy. ## pracma 1.4.9 (2013-07-16) * lapacian() now works in n dimensions, not only for n = 2. * mldivide(), mrdivide() corrected a severe typo. * numderiv(), numdiff() start with h = 1/2 instead of h = 1. * figure() platform-independent by using dev.new(). ## pracma 1.4.8 (2013-06-17) * findzeros() now finds 'quadratic' roots, too. * pdist2() added as an alias for distmat(), while pdist(X) now is distmat(X, X) (MATLAB style). ## pracma 1.4.7 (2013-05-20) * histcc() histogram with optimized number of bins. * Example of correction term for the trapz() integration. ## pracma 1.4.6 (2013-03-31) * psi() Psi polygamma function (MATLAB style). * rosenbrock() and rastrigin() functions removed. ## pracma 1.4.5 (2013-03-21) * quadcc() new, iterative Clenshaw-Curtis quadrature. * squareform() formats distance matrix (MATLAB style). ## pracma 1.4.4 (2013-03-12) * integral2() implements the two-dimensional numerical integration approach `TwoD', i.e. Gauss-Kronrod (3, 7)-points on rectangles. * integral3() three-dimensional integration based on integral2(). * triplequad() 3-dim. integration based on dblquad() (MATLAB style). ## pracma 1.4.3 (2013-03-10) * integral() combines adaptive numerical integration procedures. * cintegral() complex line integrals (rectangles and curves). ## pracma 1.4.2 (2013-03-03) * linprog() linear programming solver for linear equality and inequality constraints. ## pracma 1.4.1 (2013-02-20) * romberg() Romberg integration completely rewritten. * idivide() integer division with different roundings. ## pracma 1.4.0 (2013-02-10) * fderiv(), taylor() expanded to higher orders. * itersolve() iteration methods for solving linear systems. * lu() LU decomposition with different schemes (w/o pivoting). ## pracma 1.3.9 (2013-01-26) * pdist() as an alias for distmat() (MATLAB style). * fftshift(), ifftshift() shifting Fourier frequencies. * Improved grad(), jacobian(), hessian(), and laplacian(). ## pracma 1.3.8 (2013-01-10) * Smaller corrections, e.g., removed deprecated 'is.real'; no startup messages anymore. * geomean(), harmmean(), trimmean() geometric, harmonic, and trimmed arithmetic mean (MATLAB style). * agmean() algebraic-geometric mean. ## pracma 1.3.7 (2013-01-07) * mexpfit() multi-exponentiell fitting, separating linear and nonlinear parts of the problem. ## pracma 1.3.6 (2013-01-06) * lsqsep() separable least-squares fitting. * lsqcurvefit() nonlinear least-squares curve fitting. ## pracma 1.3.5 (2013-01-05) * cd(), pwd() directory functions (MATLAB style). * rand(), randn() changed to accept size() as input. * whos(), what() corrected for empty lists resp. directories. ## pracma 1.3.4 (2012-12-19) * what(), who(), whos(), ver() (MATLAB style). * semilogx(), semilogy(), loglog() logarithmic plots (MATLAB style) ## pracma 1.3.3 (2012-12-12) * quadv() vectorized integration. * ezpolar() easy access to the polar() function. * sortrows() sorting rows of matrices (MATLAB style). * null() alias for nullspace function (MATLAB style). * eigjacobi() Jacobi's method for eigenvalues and eigenvectors. ## pracma 1.3.2 (2012-12-08) * ellipke(), ellipj() elliptic and Jacobi elliptic integrals. * expint() implements E1 and Ei, the exponential integrals, with aliases expint_E1() and expint_Ei(). * li() the logarithmic integral (w/o offset). ## pracma 1.3.1 (2012-12-06) * Explicitely listing about 200 MATLAB-emulating function( name)s. * Dismissed matlab(), using it now for infos only, not assigning any MATLAB function names to the environment (because of CRAN policies). ## pracma 1.3.0 (2012-12-05) * cot(), csc(), sec() cotangens, cosecans, and secans functions. * acot(), acsc(), asec() inverse cotangens, cosecans, secans functions. * coth(), csch(), sech() hyperbolic cotangens, cosecans, secans functions. * acoth(), acsch(), asech() inverse hyperbolic cotangens, cosecans, and secans functions. ## pracma 1.2.9 (2012-12-02) * bvp() changed to solve second order boundary value problems. * trisolve() solves tridiagonal linear equation systems. * curvefit() fits points in the plane with a polynomial curve. ## pracma 1.2.8 (2012-11-30) * lsqlin() least-squares solver with linear equality constraints. * pinv() now works like MASS::ginv() for singular matrices. * Added the end-';' feature to str2num(). * toc() added invisible return value. ## pracma 1.2.7 (2012-11-22) * procrustes() solving the Procrustes problem, and kabsch() implements the Kabsch algorithm. * kriging() ordinary and simple Kriging interpolation. * Corrected some stupid errors in str2num(). ## pracma 1.2.6 (2012-11-11) * akimaInterp() univariate Akima interpolation. * Moved transfinite() to package 'adagio'. ## pracma 1.2.5 (2012-10-28) * histc() Histogram-like counting (MATLAB style). * Added warning to complexstep() if imaginary part is zero. ## pracma 1.2.4 (2012-10-25) * Added option 'pinv' to mldivide() to return same results as MATLAB. * str2num(), num2str() conversion functions (MATLAB style). * Removed some 'author' entries on help pages. ## pracma 1.2.3 (2012-10-17) * Renamed mrank() to Rank(). * Corrected nullspace() [thanks to Stephane Laurent], which now agrees with Octave's null() function (MASS:Null appears buggy, too). * Corrected gaussNewton() and fsolve() [thanks to Etienne Chamayou]. ## pracma 1.2.2 (2012-10-10) * bsxfun() apply binary function elementwise (MATLAB style). * added the analytic solution for the example in bvp(). ## pracma 1.2.1 (2012-09-28) * rosenbrock() added, moved testfunctions to 'adagio' package. * euler_heun() improved Euler method for solving ODEs. * logit() function added to sigmoid(). * Keyword 'ode' introduced. ## pracma 1.2.0 (2012-09-27) * matlab() can reinstall MATLAB function names. ## pracma 1.1.9 (2012-09-25) * gcd(), lcm() greatest common divisor, least common multiple now working on a vector of integers. * Removed number-theoretic functions: eulersPhi(), moebiusFun(), mertensFun(), sigma(), tau(), omega(), Omega(), primes2(), twinPrimes(), nextPrime(), previousPrime(), modpower(), modorder(), modinv(), modlin(), primroot(), contfrac(), coprime(), GCD(), LCM(), extGCD(), (these functions are now available in the 'numbers' package). ## pracma 1.1.8 (2012-09-19) * ezcontour(), ezmesh() wrappers for contour(), image(), persp(). * erfi() imaginary error function. ## pracma 1.1.7 (2012-08-06) * moler() Moler matrix ## pracma 1.1.6 (2012-07-20) * Removed '.Rapphistory' from the tests directory (again) [and use "--as-cran" for the checks]. * disp() display text or array (MATLAB Style), i.e. cat() with newline. ## pracma 1.1.5 (2012-07-18) * Renamed functions with capital first letter to avoid name clashes: mtrace -> Trace, mdiag -> Diag, strtrim -> strTrim, vnorm -> Norm, reshape -> Reshape, find -> finds, fix -> Fix, poly ->Poly, mode -> Mode, real -> Real, imag -> Imag, toeplitz -> Toeplitz. ## pracma 1.1.4 (2012-06-26) * gammainc() (lower and upper) incomplete gamma function, also the regularized gamma function, all allowing negative x values. * polylog() the polylogarithm functions for |z| < 1 and n >= -4 . ## pracma 1.1.3 (2012-06-17) * fminsearch() now implements Nelder-Mead (similar to optim), and Fletcher-Powell when "dfree=FALSE" is chosen. * Test functions rosenbrock() and rastrigin(). ## pracma 1.1.2 (2012-06-13) * nelder_mead() implements Nelder-Mead for nonlinear optimization. * hooke-jeeves() Hooke-Jeeves algorithm for direct search. * fletcher_powell() Davidon-Fletcher-Powell method for function minimization (alternative to BFGS approach). * steep_descent() minimization of functions using steepest descent. ## pracma 1.1.1 (2012-06-10) * fminbnd() now implements Brent's function minimization algorithm with golden section search and parabolic interpolation (same as optimize). * transfinite() transformation function between bounded and unbounded (box constraint) regions. ## pracma 1.1.0 (2012-06-06) * hurst(), hurstexp() calculate the Hurst exponent of a time series. * Updated the NEWS.Rd file. ## pracma 1.0.9 (2012-06-03) * lsqnonneg() solves nonnegative least-squares problems by using the trick "x --> exp(x)" and applying lsqnonlin(); example function lsqcurvefit() for nonlinear curve fitting. * Renamed ridder() to ridders(), thanks to Robert Monfera for pointing it out (he also suggested a multi-dimensional variant). ## pracma 1.0.8 (2012-05-22) * movavg() moving average of types "simple", "weighted", "modified", "exponential" (EMA), or "triangular". * modlin() solves modular linear equations. ## pracma 1.0.7 (2012-05-11) * lsqnonlin() solves nonlinear least-squares problems using the Levenberg-Marquardt approach. * renamed froots() to findzeros(), and fmins() to findmins(). ## pracma 1.0.6 (2012-04-21) * fornberg() finite difference (i.e., polynomial) approximation of derivatives for unevenly spaced grid points -- Fornberg's method. ## pracma 1.0.5 (2012-04-15) * randsample() randomly sampling, alias for sample (MATLAB style). * rands() generates uniform random points on an N-sphere. * Added tic(), toc() measuring elapsed time (MATLAB style). * previousPrime() finds the next prime below a number. ## pracma 1.0.4 (2012-04-01) * invlap() computes the inverse Lapacian numerically. * ppfit() piecewise polynomial fitting procedure. ## pracma 1.0.3 (2012-03-21) * cubicspline() interpolating cubic spline (w/ endpoint conditions). * mkpp() and ppval() for piecewise polynomial structures. ## pracma 1.0.2 (2012-03-17) * accumarray() resembles the related MATLAB function more closely. * invperm() returns the inverse of a permutation. * randperm() changed to make it more MATLAB-like. ## pracma 1.0.1 (2012-03-09) * plotyy() corrected right ordinate, prettying the labels. * peaks() peaks function (MATLAB style). ## pracma 1.0.0 (2012-03-01) * Updated the NEWS.Rd file. ## pracma 0.9.9 (2012-02-29) * qrSolve solves overdetermined system of linear equations. * DSCsearch() removed, now in package 'pracopt'. * randp() found a better, non-selective approach. ## pracma 0.9.8 (2012-02-23) * gramSchmidt() modified Gram-Schmidt process. * householder() Householder reflections and QR decomposition. * givens() Givens rotation and QR decomposition. * corrected a small error in ridder() (thanks to Roger Harbord); new example of how to use ridder() with Rmpfr for multiple precision. ## pracma 0.9.7 (2012-02-17) * erf() corrected, erfc() and erfcx() as new functions, including their inverses erfinv() and erfcinv(). * hypot() now numerically more stable (thanks to Jerry Lewis). ## pracma 0.9.6 (2012-01-25) * Changed third example for dblquad() [new Windows toolchain problem]. * Deactivated the test for gammaz() because of problems on Solaris. ## pracma 0.9.5 (2012-01-16) * kmeanspp() kmeans++ clustering algorithm. * hampel() with new option, fuelled by a blog entry of Ron Pearson. ## pracma 0.9.4 (2012-01-08) * DSCsearch() Davies-Swann-Campey search in one dimension. * Improved modpower() through modular exponentiation. added lehmann_test() Lehmann's primality test as example. * Corrected polar() and andrewsplot(). ## pracma 0.9.3 (2011-12-27) * direct1d() one-dimensional version of the DIRECT algorithm for global function minimization. ## pracma 0.9.2 (2011-12-26) * approx_entropy() approximate entropy of a time series. * circshift() circularly shifting arrays (MATLAB Style). ## pracma 0.9.1 (2011-12-12) * plotyy() plots curves with y-axes on both left and right side. * fplot() plots components of a multivariate function. ## pracma 0.9.0 (2011-12-11) * errorbar() routine for plotting error bars in both directions. * whittaker() Whittaker-Henderson smoothing** Not yet running** . * rref() reduced row echelon form. ## pracma 0.8.9 (2011-12-08) * cutpoints() automatically finds cutting points based on gaps. * hausdorff_dist calculates the Hausdorff distance / Hausdorff dimension. * nnz() number of non-zeros elements (MATLAB style). ## pracma 0.8.8 (2011-12-06) * polar() for polar plots (MATLAB style), see the example plots. * andrewsplot() plots Andrews curves in polar coordinates. * Vectorized: cart2sph(), sph2cart(), cart2pol(), pol2cart(). ## pracma 0.8.7 (2011-11-30) * deg2rad(), rad2deg(). * figure() MATLAB style and pltcross() plotting crosses. ## pracma 0.8.6 (2011-11-21) * ridder() Ridder's method for zero finding of univariate functions. ## pracma 0.8.5 (2011-11-19) * sqrtm() matrix square root, based on Denman-Beavers iteration, rootm() matrix p-th root, computing a complex contour integral, signm() matrix sign function. o fzero() now uses the new zeroin() function, i.e., a Brent-Dekker approach instead of refering to uniroot(). * twinPrimes() twin primes in a given interval, and nextPrime() will find the next higher prime. ## pracma 0.8.4 (2011-11-14) * Transformations between cartesian, spherical, polar and cylindrical coordinate systems: cart2sph(), sph2cart(), cart2pol(), pol2cart(). * randp() uniformly random points in the unit circle. ## pracma 0.8.3 (2011-11-11) * accumarray() grouping elements and applying a function to each group. * uniq() MATLAB-style 'unique' function, allsums() in the examples. * small correction to fsolve(), mentioned on the 'check summary' page. ## pracma 0.8.2 (2011-11-04) * newmark() Newmark's method for solving second order differential equations of the form y''(t) = f(t, y(t), y'(t)) on [t1, t2]. * cranknic() Crank-Nicolson 'ivp' solver, combining the forward and backward Euler methods for ordinary differential equations. ## pracma 0.8.1 (2011-10-30) * Corrected pinv() for (nearly) singular matrices. * Renamed ifactor() to factors(). ## pracma 0.8.0 (2011-10-27) * Minor corrections and improvements to the 'pracma.pdf' manual, incl. numdiff(), refindall(), trigApprox(), and subspace(). ## pracma 0.7.9 (2011-10-22) * spinterp() monotonic (and later on shape-preserving) interpolation following the approach of Delbourgo and Gregory. ## pracma 0.7.8 (2011-10-17) * bvp() solves boundary value problems of the following kind: -u''(x) + c1 u'(x) + c2 u(x) = f(x) for x in [a, b]. ## pracma 0.7.7 (2011-10-14) * primes2(n1, n2) will return all prime numbers betweeen n1 and n2 (without storing the numbers from sqrt(n2) up to n2). ## pracma 0.7.6 (2011-08-05) * gaussNewton() for function minimization and solving systems of nonlinear equations. fsolve() as a wrapper for it. * fzsolve() for root finding of complex functions. * softline() Fletcher's inexact linesearch algorithm. ## pracma 0.7.5 (2011-07-26) * Put NEWS.Rd in the /inst subdirectory (and NEWS.pdf in /doc), thanks to Kurt Hornik; slightly changed the version numbering. ## pracma 0.7-4 (2011-07-22) * rortho() generate random orthogonal matrix of size n. * Titanium data set for testing fitting procedures. ## pracma 0.7-3 (2011-07-15) * erf() and erfc() error and complementary error functions (MATLAB style) as (almost) aliases for pnorm(). * erfz() complex error function. ## pracma 0.7-2 (2011-07-11) * broyden() quasi-Newton root finding method for systems of nonlinear equations. ## pracma 0.7-1 (2011-07-09) * cross() has been vectorized (remark on R-help). ## pracma 0.7-0 (2011-07-07) * Sigmoid and Einstein functions. ## pracma 0.6-9 (2011-07-06) * Runge-Kutta-Fehlberg method of order (5,4). ## pracma 0.6-8 (2011-07-05) * triquad() Gaussian quadrature over triangles. * cotes() Newton-Cotes integration formulae for 2 to 8 nodes. ## pracma 0.6-7 (2011-07-04) * lagrangeInterp(), newtonInterp() Lagrange and Newton polynomial interpolation, neville() Neville's methods. * tril(), triu() extracting triangular matrices (MATLAB style). ## pracma 0.6-6 (2011-07-02) * charpoly() computes the characteristic polynomial, the determinant, and the inverse for matrices that are relativly small, applying the Faddejew-Leverrier method. * froots() to find *all* roots (also of second or higher order) of a univariate function in a given interval. The same with fmins() to find *all* minima. ## pracma 0.6-5 (2011-07-01) * Adams-Bashford and Adams-Moulton (i.e., multi-step) methods for ordinary differential equations in function abm3pc(). ## pracma 0.6-4 (2011-06-30) * Changed the description to be more precise about the package. ## pracma 0.6-3 (2011-06-28) * rationalfit() rational function approximation * ratinterp() rational interpolation a la Burlisch-Stoer. ## pracma 0.6-2 (2011-06-26) * pade() Pade approximation. ## pracma 0.6-1 (2011-06-25) * quadgk() adaptive Gauss-Kronrod quadrature. ## pracma 0.6-0 (2011-06-24) * Added differential equation example to expm()'s help page. * Changed NEWS file to become simpler (no subsections). ## pracma 0.5-9 (2011-06-23) * quadl() recursive adaptive Gauss-Lobatto quadrature. * simpadpt() another recursively adaptive Simpson's rule. * Added testing procedures for all integration routines; corrected, refined some of these procedures. ## pracma 0.5-8 (2011-06-20) * quadgr() Gaussian Quadrature with Richardson extrapolation, can handle singularities at endpoints and (half-)infinite intervals. ## pracma 0.5-7 (2011-06-18) * expm() for matrix exponentials. * clenshaw_curtis() the Clenshaw-Curtis quadrature formula. ## pracma 0.5-6 (2011-06-17) * simpson2d() as non-adaptive 2-dimensional Simpson integration. * dblquad() twofold application of internal function integrate(). ## pracma 0.5-5 (2011-06-15) * gaussHermite() and gaussLaguerre() for infinite intervals. * Fresnel integrals fresnelS() and frenelC(). ## pracma 0.5-4 (2011-06-12) * gaussLegendre() computes coefficients for Gauss Quadrature, and quad2d() uses these weights for 2-dimensional integration. * quadinf() wrapper for integrate() on infinite intervals. ## pracma 0.5-3 (2011-06-06) * ode23() solving first order (systems of) differential equations. * barylag2d() 2-dimensional barycentric Lagrange interpolation. ## pracma 0.5-2 (2011-06-04) * interp2() for two-dimensional interpolation. * gradient() now works in two dimensions too. ## pracma 0.5-1 (2011-06-01) * fzero(), fminbnd(), fminsearch(), fsolve() as aliases for uniroot(), optimize(), optim() with Nelder-Mead, newtonsys(). ## pracma 0.5-0 (2011-05-31) * Corrections to help pages. ## pracma 0.4-9 (2011-05-30) * romberg() and gauss_kronrod() for numerical integration. * Richardson's extrapolation in numderiv(), numdiff(). * Discrete numerical derivatives (one dimension): gradient(). ## pracma 0.4-8 (2011-05-28) * Numerical function derivatives: fderiv(), grad(). * Specialized operators: hessian(), laplacian(). * Application: taylor(). ## pracma 0.4-7 (2011-05-27) * plot vector fields: quiver() and vectorfield(). * findintervals(). * Corrections in deval(), deeve(), using findintervals(). ## pracma 0.4-6 (2011-05-26) * Laguerre's method laguerre(). * rk4() and rk4sys() classical fourth order Runge-Kutta. * deval(), deeve() evaluate ODE solutions. ## pracma 0.4-5 (2011-05-24) * Lebesgue coefficient: lebesgue(). * poly2str() for string representation of a polynomial. ## pracma 0.4-4 (2011-05-23) * Dirichlet's eta() and Riemann's zeta() function. * rmserr() different accuracy measures; std_err() standard error. ## pracma 0.4-3 (2011-05-22) * polypow() and polytrans() for polynomials. * polyApprox() polynomial approximation using Chebyshev. * trigPoly(), trigApprox() for trigonometric regression. ## pracma 0.4-2 (2011-05-17) * segm_intersect() and segm_distance() segment distances. * inpolygon(). ## pracma 0.4-1 (2011-05-13) * polyadd() polynomial addition. * conv() and deconv() time series (de)convolution. * detrend() removes (piecewise) linear trends. * ifft() for normalized inverse Fast Fourier Transform. ## pracma 0.4-0 (2011-05-10) * Added tests for functions since version 0.3-7. ## pracma 0.3-9 (2011-05-09) * and() and or(). ## pracma 0.3-8 (2011-05-06) * pchip() and option `cubic' for interp1() interpolation. * The complex gamma functions gammaz(). * hadamard() and toeplitz() matrices. ## pracma 0.3-7 (2011-05-04) * Rank of a matrix, mrank(), and nullspace() for the kernel. * orth(), orthogonal basis of the image space, and subspace() determines the angle between two subspaces. * normest() for estimating the (Frobenius) norm of a matrix, and cond() determines the condition number of a matrix. ## pracma 0.3-6 (2011-04-30) * fact(), more accurate than the R internal function `factorial'. * ezplot() as an alias for curve(), but with option ``fill = TRUE''. * aitken() for accelerating iterations. * Renamed polycnv() to polymul(). * Renamed outlierMAD() to hampel(). ## pracma 0.3-5 (2011-04-23) * Lambert W function lambertWp() for the real principal branch. * ``Complex Step'' derivation with complexstep() and complexstepJ(). ## pracma 0.3-4 (2011-04-21) * Barycentric Lagrange interpolation through barylag(). * polyfit2() fits a polynomial that exactly meets one additional point. * Added more references to the help entry `pracma-package.Rd'. ## pracma 0.3-3 (2011-04-19) * hornerdefl() for also returning the deflated polynomial. * newtonHorner() combining Newton's method and the Horner scheme for root finding for polynomials. * jacobian() computes the Jacobian of a function R^n --> R^m as simple numerical derivative. * newtonsys() applies Newton's method to functions R^n --> R^n with special application to root finding of complex functions. * newton() renamed to newtonRaphson(). ## pracma 0.3-2 (2011-04-17) * Sorting functions: bubbleSort(), insertionSort(), selectionSort(), shellSort(), heapSort(), mergeSort(), mergeOrdered(), quickSort(), quickSortx(), is.sorted(), and testSort(). * Functions from number theory: eulersPhi(), moebiusFun() and the mertensFun(), sigma(), tau(), omega(), and Omega(). ## pracma 0.3-1 (2011-04-16) * Chebyshev polynomials of the first kind: chebPoly(), chebCoeff(), and chebApprox(). ## pracma 0.3-0 (2011-04-09) * New version of NEWS.Rd, NEWS.pdf. * More test functions for root finding and quadrature. ## pracma 0.2-9 * fnorm() and the Runge function runge(). * contfrac(), rat(), and rats() for continuous fractions. * meshgrid() and magic(). ## pracma 0.2-8 * quad() adaptive Simpson quadrature. * Minimum finding with fibsearch() and golden_ratio(). * Root finding with newton(), secant(), and brentDekker(). ## pracma 0.2-7 * Regular expression functions regexp(), regexpi(), regexprep() and refindall(). ## pracma 0.2-6 * String functions blanks(), strtrim(), deblank(), strjust(), strrep(). * interp1() one-dimensional interpolation (incl. spline) ## pracma 0.2-5 * MATLAB functions mode(), clear() and beep(). ## pracma 0.2-4 * primroot() finds the smallest primitive root modulo a given n; needed functions are modpower() and modorder(). * humps() and sinc(): MATLAB test functions. * Root finding through bisection: bisect(), regulaFalsi(). * outlierMAD(), findpeaks(), and piecewise(). * polycnv() for polynomial multiplication. * Functions extgcd(), gcd(), and lcm() have been renamed to extGCD(), GCD(), and LCM() respectively. ## pracma 0.2-3 * strfind(), strfindi(), and findstr(). * circlefit() fitting a circle to plane points. * mldivide() and mrdivide(), emulating the MATLAB backslash operator. ## pracma 0.2-2 * vnorm() vector norm * Warning about a nasty "non-ASCII input" in the savgol.RD file resolved. ## pracma 0.2-1 (2011-03-17) * horner() implementing the horner scheme for evaluating a polynomial and its derivative. * savgol() Savitzki-Golay smoothing and needed pseudoinverse pinv(). ## pracma 0.2-0 * Package renamed to 'pracma' to avoid name clashes with packages such as 'matlab' that are sticking closer to the original. * Added 'pracma-package' section to the manual. ## pracma 0.1-9 (2011-03-13) * reshape(), repmat(), and blkdiag() matrix functions. * combs() chooses all combinations of k elements out of n, and randcomb() generates a random selection. * perms() generates all permutations, randperm() a random permutation. * Pascal triangle as pascal(); nchoosek() returns binomial coefficients. * Some string functions: strcmp(), strcmpi(), strcat(). ## pracma 0.1-8 (2011-03-10) * std() as refinement of the standard deviation function. * ceil() and fix() as aliases for ceiling() and trunc(). [floor() and round() already exist in R.] * Modulo functions mod(), rem() and integer division idiv(). * Integer functions related to the Euclidean algorithm: extgcd(), gcd(), lcm(), coprime(), and modinv(). * distmat() and crossn(), the vector product in n-dimensional space. ## pracma 0.1-7 (2011-03-08) * size(), numel(), ndims(), isempty(), and find(). * eye(), ones(), zeros(). * Functions returning random numbers: rand(), randn(), randi(). * linspace(), logspace(), and logseq() for linearly, logarithmically, and exponentially spaced sequences. ## pracma 0.1-6 (2011-03-06) * Matrix functions mdiag() and mtrace() added. inv() is introduced as an alias for solve() in R. * Generate special matrices hankel(), rosser(), and wilkinson(). kron() is an alias for the R function kronecker(). * Renamed factors() to ifactor() to distinguish it more clearly from factors as used in R. ## pracma 0.1-5 * Added function for flipping or rotating numeric and complex matrices: flipdim(). flipud(), fliplr(), and rot90(). ## pracma 0.1-4 * Added functions for generating sequences of (log-)linearly spaced numeric values: linspace() and logspace(). * Added basic complex functions real(), imag(), conj(), and angle() which are essentially only aliases of the R functions Re(), Im(), *r Conj(). angle() returns the angle of a complex number in radians. The R function Mod() is here only available as abs(). ## pracma 0.1-3 (2011-02-20) * Added compan() function for the `companion' matrix; the eig() function is an alias for the R eigen()values function. * Added the polynomial functions poly(), polyder(), polyfit(), polyint(), and polyval(). * roots() returns real and complex roots of polynomials. * Simplified the trapz() function. ## pracma 0.1-2 * Added functions from number theory: primes(), isprime() and factors(). The corresponding function for factors() in MATLAB/Octave is called factor(), but that name should not be shadowed in R! * Added the polyarea() and trapz() functions. ## pracma 0.1-1 * Added some simple functions such as nthroot(), pow2(), and nextpow2(). * dot() and cross() functions for scalar and vector product. * Generate matrices through vander() and hilb(). ## pracma 0.1-0 (Initial Version) ### INSTALLATION * 'pracma' will be a pure R package without using any source code. Therefore, installation will be immediate on all platforms. ### INTENTION * This package provides R implementations of more advanced math functions from MATLAB and Octave (and the Euler Math Toolbox) with a special view on optimization and time series routines. pracma/MD50000644000176200001440000007300214153577552012045 0ustar liggesusers197c7dc792e10a543b3c0fde30384a90 *COPYING ade78988ebd72c469082e57dea8a8139 *DESCRIPTION b47004d9a8e4f1d874186f4b543a3c8e *NAMESPACE e8fb3e68f4c4f8f711fa43b3b591f460 *NEWS 9b74f455341dfcb08d66486d666f68d1 *NEWS.md 8e2ec5415edc8417dd8da8cb53d8d0b9 *R/abm3.R 556a17b11b7876e19e56a799aa125485 *R/accumarray.R 3a2bb5e25f1e3c1bbd2bfc930776a25d *R/agmean.R 36b76525f14a801a1326896457809d67 *R/aitken.R c4a7fa3da031e3cc0e19ff03cf3fa304 *R/akima.R 0878d5c778f27549674adacba78d44eb *R/andor.R c4751d2108981466d37c2bc65dc7aec0 *R/andrews.R 52b916762d9c51bc7479906eab7f83ac *R/angle.R 29ac235a53d3e3ee1a2edf4949315bf6 *R/anms.R a7c73bd0537e8f7d7898878c599703d8 *R/arclength.R ce0133e9b0d6f4ba86009297e870970c *R/arnoldi.R 51738592c790f0df96cc39018dfbad2e *R/barycentric.R ca6fbf27ca08f18b2a41032af12b1cbb *R/beep.R 970902bcf45662793ec8aaa2d1b2dc33 *R/bernoulli.R 68404e7af004ddd0fcf705a5d762858a *R/bernstein.R 3b703ce623ee1b8f73fa8e443fb8a572 *R/bisect.R 1aa758af79d57e55006c0b28abc6ef8b *R/bits.R dc8f057f63bf3734aa7fb097f3f6200f *R/blkdiag.R 7ad13a757bd5ca249f0c25df820e1e42 *R/brentdekker.R 9e28b61be213e102398571ce05417a03 *R/broyden.R 37546b6cc8a986b3ec69104407bee525 *R/bsxfun.R cf30354a8e529526a39c63faaf48c106 *R/bvp.R e8513dc322aee02d4d9f902747405d22 *R/cart2sph.R aea7658470693c1dfeb2b48e5c4ba090 *R/charpoly.R a54f4ba4671587dafe6fedcc2dc910d6 *R/chebyshev.R 46d5d54b3c2f04f081406264aaf0c2c0 *R/circlefit.R 12676eeb0839ee09ccf8a1af7324c168 *R/circshift.R 9373abcf54c3ee7bf1d9a5348c140021 *R/clear.R 9b1bba72e0a51e16033daf4a876ca4fd *R/clenshaw_curtis.R a966025077d1c04ed39a99a773a7b16a *R/combs.R a40d60afdcb374859e0a4f66258b9fbd *R/compan.R 91ee2ec4da750e17dd8c727ed61eca1a *R/complexstep.R 673deb0c711b8835888b6f1e7323b9a8 *R/cond.R dc69bc00ce9fafd6c2593485dd6ce2d4 *R/conv.R 6afaec59708c26353e66ed629d53537e *R/cotes.R 2834cd093b5e18d0114d95a0827e394a *R/cranknic.R 2b29489353d52d952a5e13fcfa330881 *R/cross.R 54a076f04e6c91bfd38dff2fb393b02a *R/crossn.R 47eef58ff7ffb1e4cba0ee4285d5d849 *R/cubicspline.R b5e8704f4f496c921e2219452cfebe71 *R/curvefit.R 1f83ad89b99b4d624d8c6c1b9b6b543b *R/cutpoints.R e21d2afcecbd3f6fcff5bc91052b438e *R/dblquad.R 1767d57d7c1c52c13d7e59e6d45a5872 *R/deconv.R b02befdcbab0cef6dfa09fcbd8eaa4c5 *R/deg2rad.R 228709802a4173e6b8e4cad292087ebd *R/detrend.R 665bcd428aa617127c71e90d8387045f *R/deval.R a5a8eca4246ab1471457cafbbb0b0d55 *R/diag.R 977bde608361e69ddaa5c1b7a3bbb57f *R/distmat.R 71d757fb4331d199f50c6017d9a885fb *R/dot.R 3dc04ae9600b5561e8c6362486a45322 *R/eig.R effd742d3674c6fba761ec32896edaea *R/eigjacobi.R dac06ffb40ddde5ce0f22a0b0da93f3c *R/einsteinF.R b995c9b70e1fd8b7396985cfc9ef7087 *R/ellip.R c8884bc09067c7c5ada83cbe59225abf *R/entropy.R 188a79aaaeb654af3fa1197230fccdd2 *R/eps.R fccb85c1ae1432db21a306c8b35f290c *R/erf.R a3f834724211fa0bdfe49ece1a44037c *R/errorbar.R 5329eb792cb2ba8b102f552f27f616fc *R/euler_heun.R f9280c4a9e244cddc14d669517a77e68 *R/expint.R 22ed00df878efa30e4c08d992a61a90d *R/expm.R 25add2b4e740038778e4722741620322 *R/eye.R f4bf0ae8cbb68afb0e4389e697a52a61 *R/ezplot.R d279f62dd074c176543eff0377b9f7a1 *R/fact.R 44337c1fc4ed686379bf16fde8f05d6e *R/factors.R 8cb7a998103694043c56c887f7ce7301 *R/fderiv.R de147e19f68da165be9624d11f62179c *R/fft.R 013bbc84541deb20902e68f9c98e70cc *R/fibsearch.R 547e84f6bb77bf389b17ad1bfd6e4868 *R/figure.R 6438cd8bc89cb4d1ce41af14f6360b3c *R/find.R 026fba53794a295f62ce26fcf12d3f45 *R/findintervals.R 70a3e2af2035768c66f2ca75dd9217f2 *R/findpeaks.R c5d7590f1b2a1b683ab39ef041e35369 *R/findzeros.R acd19dc04b1cfe80c83bcef3e5fc03c3 *R/fletcherpowell.R d99ccd15d4f16139ee0dfa612f763064 *R/flipdim.R 30a87c9a3ada95cb756ee2b071285c4b *R/fminbnd.R 8d524888fd19d633ba8dc72f11ba3ae3 *R/fmincon.R 72a8d96727ab59c5e60d7c1e6b2fb87b *R/fminsearch.R 8c5d5f24e71b107fe6b9b6565b1b4e83 *R/fminunc.R 508b6a97c85342713d5b2a4b1a0ce256 *R/fnorm.R 1ecf8f2687247b9eb35da04a1c0f4d36 *R/fornberg.R f84873285a20a26b925f259c9de39918 *R/fprintf.R 74f5c84804dbe855ed1819a2b9e312c0 *R/fractalcurve.R 79a43056700701e86763f4ff1425b28e *R/fresnel.R a00c5c7193623f46ad0767efe6678ac2 *R/fsolve.R 7634c817b57201a3bf090b7e049494e1 *R/fzero.R 6f52d17952b26829d2356681ffc09ad0 *R/gamma.R 411aec87a73b54bd1fc4397bb0833ddb *R/gammainc.R 710bb9e9b7232cf7b64b88d2b018dbb6 *R/gaussLegendre.R 63709e6d34a84831a493b58c211b771c *R/gaussNewton.R 676e7644793100d3e7564dbdbc4e9d8f *R/gauss_kronrod.R deaa49d6bf1cb16e8d82bb7d4235a009 *R/geo_median.R 508e190ca36b3bfede8f835c2fdad96e *R/gmres.R 50df2e771bb1c38e7489dd84c80c3d53 *R/golden_ratio.R 87ca1ec3e15370d16191363b26f4f01d *R/grad.R 345c0ad26ecbf29a5f67231cbcd18c9d *R/gradient.R a99d3d7e3b6ae1faf1fc13a6e7686529 *R/hadamard.R ff8c80cd953a86d5c60b35d7c6589a0a *R/hampel.R a3d0e2a9b5b1501750877f07b38815e4 *R/hankel.R 4663d5a22228719d283b1afa4950546f *R/haversine.R 27abb296d86cb6f10135982087c1876a *R/hessenberg.R c0852620fd3aa4a103fc26a0a16a9cc5 *R/hessian.R a0d68ef073709fcd7fe6496c309704a3 *R/hilb.R f80a9325d8e2fb5d7fc4cc19563e0721 *R/histc.R dfef217a6248b95f90072b345229fc10 *R/hookejeeves.R 07f92e22eaf8128721c7e3e5847a01de *R/horner.R 37004c9b4321b1923708be7bbad8d35e *R/humps.R 4b35a29bd3f0fdc8e3d1b7c1194273db *R/hurst.R ab29151d9f62ff8791b5b32b91ea41f2 *R/hyperbolic.R 09602a40c2bf3564072b15124f49cace *R/hypot.R 5d8f535d7964cc3589325ce0d8b0b3ca *R/inpolygon.R 119665d57e9becfcd31a84d2d7a09fa8 *R/integral.R 231429444401d4a35435d67deb09d396 *R/integral2.R b16eb56803cd98f33abaf1d4ec4b6ee1 *R/interp1.R a7eec4a294d924da5700ad81f86bb44f *R/interp2.R 80e60e7800846180db112bd513bd4c52 *R/inv.R bb967115030a2ad25bf534f151f3beb2 *R/invlap.R 2e5a9016d9f5d544347ac2fff37efa92 *R/isposdef.R e4d7d1216d4484b2c0aea86ff0c9ab50 *R/isprime.R dc89fabdab452c471b07d4c4235a2190 *R/itersolve.R 239058bb1a545c942a6e52ba2b679018 *R/kriging.R 8042eddeb863a3c316cd4645c99aa77b *R/kron.R 8c6e662ec6029bce5677f85ed4f82895 *R/l1linreg.R d46da0be014b0483950ee3853a3ed8ce *R/laguerre.R d63ae3213447515b0f780c27ec95c035 *R/lambertW.R 40e850bebe7609cb66ac9a21036c2d3e *R/lebesgue.R 99b4c72a237265bb089138d34beb2b16 *R/legendre.R 43e229c055d04f36d71fab6babb184b3 *R/linearproj.R bdfd4166c6e97a94ee8ab3f924220414 *R/linprog.R f5ba573c81263a3fa84cb1027a5a40cb *R/linspace.R 226d83f126fe8a93823cbe245deae998 *R/lsqlin.R 159c358786de1eb7f3c598031e628616 *R/lsqlincon.R 5aca5f3b8e5a0bd5b99a0672d32a8e4a *R/lsqnonlin.R d822cd6389752fa30a5f40493ac683c4 *R/lsqnonneg.R b2511db2adbd247fda9c1af969923299 *R/lu.R f384616a04f11141cfb8e3774e6e1472 *R/magic.R 46c1e40a49abb8807aa7a3adccb466b2 *R/matlab.R c6ea360afbbfa25f7e99570f8ad6a814 *R/mean.R 6cfc4756848dc1b6dd6b71bb61e5ece7 *R/meshgrid.R f8cf47ad7fa3e693452945167e43ff60 *R/mexpfit.R 88dfe302153c5ab5d4a7d7bae6214c90 *R/midpoint.R 7a71a240ed11fb6d9ae81a85848039ef *R/mldivide.R a78cfa1bce7436b0f7d2cfe637eb99b4 *R/mode.R 6c0d743752f4f71bac3daaeb7c2a0c0d *R/modular.R dc29399b39b66e33bc6b277c1aad826c *R/moler.R a6a252c88d24387b54f5de6374805f39 *R/movavg.R 952a8f01cdc14d03a7d517d4e7b64cc2 *R/muller.R 78f9f6f13a299544a7f5b3a3e6ed55fe *R/nchoosek.R 364ea206b6394f42888eda95f8fd6824 *R/nearest_spd.R 045d25279d801bc90a381df677b974b6 *R/neldermead.R ba2c8d634846c51e77b4fdac1887b5c4 *R/neville.R 1c9c683e9bfba3c98fa2305275cf115e *R/newmark.R 5ceec011d80c67ee92061a1a2f9ad8bd *R/newton.R 62bc4a1191adb4e07286a465bbd52986 *R/newtonsys.R c0b035839f0a65b0ac7552183682ab56 *R/nextpow2.R e17e65a86178d35db3b292b3264209d6 *R/norm.R 31abc42a8888dbed197f3cdc45dd5726 *R/normest.R 51a165a4141187bfcb436fb70e608e54 *R/nthroot.R 5a20423ab216b530a0a5c9c55c939d6f *R/numderiv.R 227edff61515a5ebfdee9bc92983efd7 *R/ode23.R 9113726eeb629f95c947f999a3008a9b *R/ode23s.R e2bb80a60048bc6d36d9873e93cb47c5 *R/ode45.R a44881cfa37b0c3dfe2e0095b04dce9a *R/ode78.R 0e337f7057164fd73018b143ff23c46e *R/odregress.R e163938a5699839aa2b2cd4726f15f51 *R/pade.R 69eac0c2321f2d49fec8b71fb0932c04 *R/pascal.R 35751b38092e0b03a19307a02048cbf8 *R/pchip.R db6982dd5d245d6ccef2272849cb35ba *R/perms.R 9146e792b5a27ee9d36be1707d4cd8c0 *R/piecewise.R f76b9b9ad70ac777140af0144c352fd5 *R/pinv.R a5ad6f5fca02f735f55d0e89d1d3485c *R/plotyy.R 0181be03387431112a3114da4a8c2ac6 *R/poisson2disk.R ce4320e4ce3c7d8e2033f3b78ef18157 *R/polar.R 21201a6fc7716307fb8cb129d8df344c *R/polyApprox.R 91c5ac884815a0b6b22091f198b0563b *R/polyarea.R 12e464e35b21432bd53dd1dfcba09395 *R/polyfit.R 2e8d039be82f14ed71fa06b563a0b82d *R/polylog.R bb6a66ad5e907628ba1d2ca46bcfcd46 *R/polynomials.R 33188dc53934a505c5d646c2eecf3bbb *R/polyval.R 45f056895dd93597bd18a2773dffa787 *R/pow2.R 38500814e798c7a12d5e9776ccd13722 *R/pp.R a2534b63036c8b6306b2e9b65204fe00 *R/ppfit.R 2984bf2666ba87d36fa62d2a6ac297c0 *R/primes.R e805a0b620e99a42ef609668e987a7d3 *R/procrustes.R 549db7cfa6b1ed1bba389b6b2984a7ca *R/psi.R c5312603e3f5fecddbfbc02d414eb6d5 *R/qpspecial.R bc41a8bd21c03cb26cbd5cc4e06d9b33 *R/qr.R 0b1ca126c97c3d5305958cfd4de1a60f *R/quad.R f536d23fe8a50dfee816923a819b286c *R/quad2d.R b89add8a0127b680043cd00de82e7185 *R/quadcc.R 689027b252753799396d5c3b4b8ffbd7 *R/quadgk.R f47837590022c2a4991596472c5f0185 *R/quadgr.R 134ed0714bfad0269e8d7c518f6bcebb *R/quadinf.R 25513ce418ecdb2684bc3a34a735fd56 *R/quadl.R 026f73f44e266baf42977a639099734e *R/quadprog.R 990a7f5faf9d905d31071f8ebf756d8d *R/quadv.R d1ebd06a85cc0a05e314fb0abbacbcac *R/rand.R 49fb204f0a132ce754d65e2949679fbe *R/randortho.R 5a6e727d03d721f4cddf28521420eb25 *R/rank.R af8b088bfa6ac6dcdafa6185ed3efbfd *R/rat.R fe456969508abd6320e217d8d0934431 *R/ratinterp.R a59b1b354ee35b2f8cc3de3e3d057972 *R/rationalfit.R 1530d8b1c5b6169f519c16307cab38d8 *R/rectint.R daa505fb1a3eb78b256a3baca3123873 *R/regexp.R dd20a5d7f54f429acacbf33a74d742b7 *R/repmat.R f0c5959648164ad8ed596f61e1437e40 *R/ridders.R f62b223d0e3ecc2131d98ee9b15f91fb *R/rk4.R 195da6b01418209cf5ea3a46bafa6996 *R/rkf54.R e63ba7247aaf72e25dedd1f1a340eac2 *R/rmserr.R 4b60c91641b3c30c67f155a6836bc2bf *R/romberg.R 55980ac1ad18bcffc12fe4051cc37a95 *R/roots.R 3c0c222e651f9d1239fe8e60496fd691 *R/rosser.R f570124cb59e5a19ba04f1ef1007548f *R/rref.R e4d0bd6fac6edd6b4ec0049b8ab663de *R/runge.R 2172e21cf2611fec497309a6ec4ddbf3 *R/savgol.R 173d038957f6ea9d0c2a88b0723dbb7a *R/segment.R 214bff066f5f17cafbba8379a7c4c883 *R/semilog.R d91c242d9d1c1697354c1bad536d9273 *R/shooting.R b2ce19ba7cfd11352f00936c30fb4097 *R/shubert.R 0c91299621602670d7bda2829e797f8c *R/sici.R 21d2462eef922d0084d7b084bd1b6235 *R/sigmoid.R 954dfc0a0e58bb682f60a268224a4870 *R/simpadpt.R 84fcb71d922ff9a609b10e8df9f0b512 *R/sind.R 7f4533a13cdd59aea4afaac918780b0a *R/size.R 6410b9551b51870dee41d8abf3e88bd6 *R/softline.R f36aa48926a7d3377fc60daaf244c02e *R/sorting.R c36d35f66a9eb4a455ce3d22cef97458 *R/spinterp.R d08d663609017622c9e0fe78a3a5545d *R/sqrtm.R 4ccc97a238882cd4672219deedba984c *R/std.R a77d11fd7977d418d7f75ea928491a0c *R/steep_descent.R aadfe165c5c08368d382a03e373cd88b *R/str2num.R 7ece14893f9c98556e3a303a96979a42 *R/strfind.R 26976cf70e08a396523573a2ecd6fa29 *R/strings.R e724c4aae89e3b8c015488f5f52ed3cf *R/subspace.R 79ce8079b10fa2e6b77a324de77f8cdb *R/sumalt.R 46222a6afa44cb7e9decf84ec7cf5e21 *R/taylor.R c50895f647c784d80309a399bc616974 *R/tictoc.R 02897bca5d57aed20ae7357386154b22 *R/trace.R aa34353051c74e4b35735089ee80ff70 *R/trapz.R 475601ba8dad6827c1aff6551f5f75ea *R/tri.R 8468a641fd8f1238c4d4d34b610e2549 *R/trigregress.R 9b7491bfcb3e7c547c6ef1558c4c2743 *R/triquad.R d6b01be994d2d920720bbcbc29b724e2 *R/trisolve.R 7e89e0f5e96709de53ab96b817945239 *R/vander.R af5250aca37ab527dfc90b677dce63a8 *R/vectorfield.R 5bd0ca2d671f733779c7af5d289641d1 *R/whittaker.R f52be7d201dbc9a815c229b58dab11dd *R/wilkinson.R e09f92a7ba7e72fbfbc3e2dec887b3fc *R/zeta.R f9ccb58211bc1dfbd6910db8dc4d3250 *R/zzz.R 63cb6de8d50ee50a87e8a1b97eb8a2bc *README.md 8a6dbc0c165232f96f97bacd6ef378fc *data/brown72.rda 4dc860eef1968c1fb106830edbff024f *data/titanium.rda b0665e750dc8a153600fa13f2863447a *demo/00Index dadc96a0ba340629e215cdd44344dcb3 *demo/pracma.R ca30ca6722fad23dde2a739ec7b57e4f *man/abm3.Rd b1d87bf72c53b58ecf57a72d677583d8 *man/accumarray.Rd 19c518d684af43a0ca546969dd0dc9c8 *man/agmean.Rd a2f338deb22ae9f6f6bed6cedd5b2397 *man/aitken.Rd c9ac278601cafcd30780cfa7134210d4 *man/akima.Rd 5d88a0d8036409e06cf42ed2ba39d589 *man/andor.Rd b7cd06192a6d3bcf1ba1b1c49f01efd9 *man/andrews.Rd 18210f37cc8db522e20ba4d9d1c7351c *man/angle.Rd 1bd51db83663d6036203074407fad92c *man/anms.Rd ee7ca1b93d9694de161eb24395e6d486 *man/arclength.Rd ed3fba93b4c3ec239d35e3dd55e7ca52 *man/arnoldi.Rd 7e284a426f5c259c3f41f17289f50360 *man/barylag.Rd b0123a086103cd7333f2be74c5e2311d *man/barylag2d.Rd a461d36d634becb0561e856b1d758569 *man/beep.Rd 1a49d9c8f477f3d21c65f33bcd6e0bfd *man/bernoulli.Rd cedf2546d1cd3b676c2cc18e40a65678 *man/bernstein.Rd f64556bc1f8e32bb557e30086cd98e87 *man/bisect.Rd 2f2c1969da40d754f616e58055f92693 *man/bits.Rd a3f44a1b3f4e3904e3d780b6839f67bf *man/blanks.Rd 20febf44ac4c2073541ab1b2ec3bc935 *man/blkdiag.Rd 3e146bd2ecf253b6e7c1ecaa7f4a89ee *man/brentdekker.Rd 99c145fc5eb4c0b464f80906054215f1 *man/brown72.Rd 25f37fb6eb50a7b7d517678bcc3e3d48 *man/broyden.Rd d411270e7b17fd6b9bde99400a2b0951 *man/bsxfun.Rd 3d482458ee0cc98fa4cc7732d2109f3d *man/bvp.Rd 03291f138fd823189b63fe5f7786c161 *man/cart2sph.Rd c3c7b8b2b92976c387544d8f1574904e *man/cd.Rd 7088879cbc952d05a1ff4270da186eac *man/ceil.Rd 615c359cad3f7cf5c7d483c406bb0b78 *man/charpoly.Rd fb7c8b0ba0f14ad3972f6920dcddbc37 *man/chebApprox.Rd c7bac6f0aeeaaee1fb969544f1405e86 *man/chebCoeff.Rd 2b43792b468ec0168e23fb171d7c2e41 *man/chebPoly.Rd fbb445dbee856f30ddd8b6c286d890a8 *man/circlefit.Rd 034f19cf456f73eb77c981292b35debf *man/clear.Rd 6d3b865dec69d4c41c262ed336239911 *man/clenshaw_curtis.Rd f837f40ccad34efe0caa2abedff8a74d *man/combs.Rd ce44fcfa17f4bdad4df7651931c0cbbf *man/compan.Rd 12253b49ed77a56aa3497e820502d6f4 *man/complexstep.Rd 2ca904cb45389157038e8f641e957a18 *man/cond.Rd 3924057942ed070076c98d3131534844 *man/conv.Rd 679cb1c9df5ba38b64b5ed45defd3953 *man/cotes.Rd 225cb5400221111962a442b72194b2b8 *man/cranknic.Rd c279adcd83ddea79fc7fb4ad64c29c75 *man/cross.Rd 426989544114e8abc9601c27774dc75d *man/crossn.Rd 313d55f4769714c7659b2d081c37e7bb *man/cubicspline.Rd 64902d9be80cea4e72fe0c811772c707 *man/curvefit.Rd d6eaae2b7fd4510d8ca60ef984fcb147 *man/cutpoints.Rd 3ce6f6eafea96c336e86d71299158dd2 *man/dblquad.Rd e5722bb552424ab80246656ec41f5188 *man/deconv.Rd ea100eb44249aa1b3f5a8e6e2a831a06 *man/deeve.Rd 344834a816cf811cf6ba3c3f927aff5f *man/deg2rad.Rd ea39b9f94a605cf0b3d2a0a0a239f04b *man/detrend.Rd c2aa4e0b4309aca6b104dade1ea39298 *man/deval.Rd 14705d400a4aca54fcda8574f0a12390 *man/diag.Rd 1ac48a77a97712dd770fb1560a53b00f *man/distmat.Rd 9c95a88ad09fd322dc12ffecfb126997 *man/dot.Rd 5ccdb1d4550fc55715936950f7d4bfcd *man/eig.Rd ae2e2f4debc98c03e0c9baff3dbc61dc *man/eigjacobi.Rd 67ad09b49dc55793ef424c7681ed01ad *man/einsteinF.Rd 9e51aee0f471572cd7d84c613d2e9b8d *man/ellip.Rd 3dfdebe5026475ee0d0caae50b22e676 *man/entropy.Rd bf73a3aa553d60119ce7bbd4474fd96f *man/eps.Rd 6316ec531efad10c2c4df1c80b8867b5 *man/erfz.Rd b61079df802afdcac37929f819633a2e *man/errorbar.Rd 03f2591af56d9e857b8d4bfcd7425118 *man/eta.Rd eea42e38f0e90ae5159f264f216a2851 *man/euler_heun.Rd 006c71504c128f9ca45a62eaec9645cd *man/expint.Rd 5c400b64d8c18169d4a1cee38866ca08 *man/expm.Rd 065d1cdb596a241836839b97f949b01d *man/eye.Rd 59d3bfc78764aded2f9221201a4f008e *man/ezcontour.Rd 7472a7841933421e082fad15b0326e86 *man/ezplot.Rd 5d71bcb2c900160ad6e0c16462b60192 *man/ezpolar.Rd 69f61ad723545a4f7591f8b94c65d63b *man/fact.Rd 7ef1c8290955e2c5986abdccb46bddc0 *man/factors.Rd d857bf92a75f47782715774371107f4f *man/fderiv.Rd 16598fc3e338efeacee6d60bf52d6b41 *man/fibsearch.Rd 61e45689dcacff11762ef9f0b4cb8b5f *man/figure.Rd a08d6512817f466fa46b4dba2301f4ea *man/find.Rd 474d713f9b974c3c810f382ec4e30afd *man/findintervals.Rd 787810a289ca07366d97554722bf1023 *man/findmins.Rd 6ba8a9627b11bf0876f7b4ac8874b2d9 *man/findpeaks.Rd 04e5c86a442ec65ef3604ffd030395e7 *man/findzeros.Rd b8085ff1f8ebea074ed6de9961c55ac6 *man/fletcherpowell.Rd b6ed9b3d935eb2410b319077e579b8cf *man/flipdim.Rd 304294f36ab7bf25a6b0007b3e24e510 *man/fminbnd.Rd d7bc9166e38ad0c4b47020d7b7e22fcc *man/fmincon.Rd 09fbd882ddd7ed259bb1b455f29cacbc *man/fminsearch.Rd 1e2637ddc29d3b8ccbfc1c54fe84139d *man/fminunc.Rd 6a7c4a699841ecb4e74c63210dc54feb *man/fnorm.Rd 431b5105e9ccb1c07d506d0f9a4a3f8b *man/fornberg.Rd 4ca99f89824f99eae3055d12468289da *man/fprintf.Rd befb665b74155e19b65f5eb7dfff6209 *man/fractalcurve.Rd 5e427cde7ab20bd82defcaa3e0ce9f8d *man/fresnel.Rd 06e549833543f14e24d4f74aa3b792cb *man/fsolve.Rd a762fb3beaec8849815d39a1b356a616 *man/fzero.Rd 63e21c455522cad2f0499d29aece0066 *man/fzsolve.Rd b768e31ec73a3f718b52e29295f171ef *man/gammainc.Rd 663db66a9e03ac6d7cedf42661891cec *man/gammaz.Rd f2fc39b73afb199211f175b938c0cc42 *man/gaussHermite.Rd 9236a4bc497f33858ee8ddd6e68cb230 *man/gaussLaguerre.Rd f71e86f12cb69726981aaf24306e4f5f *man/gaussLegendre.Rd be37bf406412abe603eef50384c03186 *man/gaussNewton.Rd a4a716e0f11dc17437071d4941319a4f *man/gauss_kronrod.Rd 2827ef00b63cc0a0189c72f47d6f7758 *man/gcd.Rd 62e3cb26c646c9c350c58f7ae4487e52 *man/geo_median.Rd 0493181bbc4b81aba977caf76c548274 *man/givens.Rd 995a2634fb3e5c35d7d0455ffaf3ffc2 *man/gmres.Rd 159e72f009373481b79283b2dbedc37b *man/golden_ratio.Rd cc8cf2ded7338554c4c6245060e969b7 *man/grad.Rd 644eaf6503c47e55a5491627a79c6d80 *man/gradient.Rd de219bff897a515436fd436c7a20492c *man/gramschmidt.Rd 04ef587280ee10efa74fb50f1b44e257 *man/hadamard.Rd 3fae9218d48594803fd297a7c30ace47 *man/halley.Rd 3219da15c69b1668bfec8720012cedac *man/hampel.Rd 88c95da19c600eff3879ec0a87120096 *man/hankel.Rd e09d3a5986292cffe34b8a14ca7df209 *man/hausdorff.Rd 1b1cf068ff65f82b3e4d7609c104a7fd *man/haversine.Rd b96d07512f0a60d0811206b249b3262c *man/hessenberg.Rd eb7b018d68b74f1445b30f4ff2cbc7d3 *man/hessian.Rd 143b2dd542e22dbc09500460e2b1e6c9 *man/hilb.Rd 487ef4aa9087604f84e74b511aefd046 *man/histc.Rd 2d15dec8f96220dbb53d4577792c564d *man/histss.Rd 03122492ef6f21da4c075d84a4df265d *man/hookejeeves.Rd 262cace7de5426a52d2b5e760ecc325c *man/horner.Rd e64e6f1e7f3a6b57a47df9b4a8ad2d0e *man/householder.Rd 187083af45421e71f1ca1a98d2c97c25 *man/humps.Rd 15589903c5559d599879b3353ec646da *man/hurst.Rd 171b3b827312f56ca1cb2bab8c0e44eb *man/hyperbolic.Rd 132f4aa1cbfbddff65f887ee7a9cc0e0 *man/hypot.Rd 70ca3ee00d7abb441ab7f5cb5977b5a5 *man/ifft.Rd 9023020a15e8e46fe7a94c2d8ad9aeee *man/inpolygon.Rd 3d4095680508d576bac631b7dd022d4f *man/integral.Rd 2ca5975a1c6ada4af67fab81644466cb *man/integral2.Rd 9b160222568bf545344f93a08bc20f87 *man/interp1.Rd 9d14ff4dc33243a3f3e0b76cbae022ac *man/interp2.Rd 04bfb2eeb463c2a0a8e6d0d3dc400a35 *man/inv.Rd 6bd6c4a16ee82b97c0bf0cae1d5e69f7 *man/invlap.Rd 151efe2679e5d9f56e14eb8413b55e71 *man/isempty.Rd e22d7fd56bb20ccba6ced3f0a7e1b618 *man/isposdef.Rd 9a4231348da80d3bf2f1572444e7db44 *man/isprime.Rd 3ab4e5e262aca6e82f991433a4804a69 *man/itersolve.Rd d8bed0d44f02f810973fbbcbd78d5a4a *man/jacobian.Rd 9856242f87106c8318e0ac890a970ba5 *man/kriging.Rd 9849b0eb0f7e3912a9ce096660642c88 *man/kron.Rd 04cbcb9b6c60b538824d68e9296ccd7c *man/l1linreg.Rd 792ac53d9833f41068ac7717e233de03 *man/laguerre.Rd 1c92edfb7f5256dd4f92e53e442fb289 *man/lambertW.Rd 0ab59759d3c0189db1dd76d718f37def *man/laplacian.Rd a2b047371a693ea0893f8a08e9d33f14 *man/lebesgue.Rd e0e94623450a96018b917a295bea02ed *man/legendre.Rd 3a8e5dfc121640b77b5dbcca5f596a02 *man/line_integral.Rd 2649e1c2d3c54e219bb183efa98a44c4 *man/linearproj.Rd 6dc0d582825104a3b1f7e7097c47d16f *man/linprog.Rd 4d031279caac8963f8903a7363953502 *man/linspace.Rd 0f905f01ddf2cd36654c5efee0436399 *man/logspace.Rd 2b77bf88cb9c27525115c591b8e680e5 *man/lsqlin.Rd 497e23dede0ce0ad6eab1b769ca6f28e *man/lsqlincon.Rd 6e035a297e18b54f94867011cd8f961f *man/lsqnonlin.Rd 80780f0daafd70391bc748f09049da34 *man/lu.Rd d10b9378eac9601500e92fb2eac442a1 *man/magic.Rd 7f3fafecb68f314e1ed2f3da8bfa70f9 *man/matlab.Rd 04d39f78c3a8dc9a838829d93219f8ba *man/mean.Rd f1afe7c965b684dc31ca8bf58b9b8995 *man/meshgrid.Rd 2732be74bcccc812964dbb0ce1b8bedc *man/mexpfit.Rd a4ac71b36cf7d07ea93c55a01e1231e8 *man/midpoint.Rd 46867b51da6a3556e44c0e7e2a8fdcc1 *man/mldivide.Rd f363b0a289a8ff045ec4009168189c40 *man/mod.Rd 84a3a564b8dd09029b772e44ebc5c7c0 *man/mode.Rd 6b4ba9da18fb3a6feb431d70f1c9a001 *man/moler.Rd 8f0beca3106fd638b667870f4d75ec33 *man/movavg.Rd ad1c420a337bdb132b9f7e8a344ad8c9 *man/muller.Rd 86416287fc18607df7b79d0d6ce96e12 *man/nchoosek.Rd 0033d81cab1d5148db9afefc5ce274e9 *man/ndims.Rd 948e9fb7d2f2c4b58a162abe6f4793cd *man/nearest_spd.Rd 63a59882c65576c4da9091027d01b9b0 *man/neldermead.Rd 80ab1e40907848579a52ea0d255b570a *man/neville.Rd 2e25bca64716966b36d538b270c85a0f *man/newmark.Rd 37a3abf2b303b47de7e3a407056d0bc8 *man/newtonHorner.Rd 94101e8ceaadded13dda8d9f8f31cdfe *man/newtonInterp.Rd d8e4dae5d5f6c23c893f780ffc284c50 *man/newtonRaphson.Rd 1ef0d4b5bbc42443b7aa37014783f040 *man/newtonsys.Rd a8f5c277cf359ab48729435c26dac33e *man/nextpow2.Rd 876290c544ff37694c296feb44fa0eb9 *man/nnz.Rd 1c9befeaa488b5947e710eaf54796d32 *man/norm.Rd 2549d2bb7ca4e89bcc6fec571f0ae4eb *man/normest.Rd 1c0b3bbe88cc591a2482132dfea3a514 *man/nthroot.Rd 73b27ae17691ff660af81cb365c7b3e0 *man/nullspace.Rd 95e1565cf2c8ffea58953766c72ec6b1 *man/numderiv.Rd bfe28186612b58ccb6e8297b6b9059f3 *man/numel.Rd 1edcec0801c090b021fa835858470afe *man/ode.Rd f489fac55ef8a0ff70bf6c3e14fbd18d *man/odregress.Rd 707249d0a5f0558d225e1c561d53aab2 *man/orth.Rd 55df8637ff57d3d19031cc72a3e76fc8 *man/pade.Rd fe90d9c86a673352251543328b564995 *man/pascal.Rd bad2493cb6249c765a4f56a10c86f0f8 *man/pchip.Rd 5b89b25d04271b607ba47641390c98ba *man/peaks.Rd 9da05d1a02d93d8e0fa5b0bb3480f549 *man/perms.Rd 450e5d542942fc4ac42aba6856a80f4d *man/piecewise.Rd 8e37ea77d47d415f3752b98bc57010e7 *man/pinv.Rd ac0eb3a8827ff362eda88fe83a5777c0 *man/plotyy.Rd 6647be231ad079396f675765a8ff62b5 *man/poisson2disk.Rd 801f147b139f54615f2abd40660deaef *man/polar.Rd f3733d83d541db80952fd09d3f12b8ef *man/poly.Rd cf72258739e2ab7aa44afb2a852d3e1c *man/poly2str.Rd 67de1155f8cfe0873bf3647d423cddfa *man/polyApprox.Rd 63b5c56b36ff8dfd0fa7449f29a1bf54 *man/polyadd.Rd 4a79487021e35831041862499510f060 *man/polyarea.Rd 668fc1227731ac66ab9de26b3a2df230 *man/polyder.Rd e5b1162b5236ffc5ab9dccb890b5700d *man/polyfit.Rd eb4bdb8303670ef4a9c2e92696d91e60 *man/polyint.Rd f8d28b28323935223d3b6b3a7731271b *man/polylog.Rd 45c8690d280baa9e6e0ee2d9e0f963f7 *man/polymul.Rd 146c34e5c2b1482ec0f78fcacfdb152e *man/polypow.Rd 0528b6a90c60c0fdbd578a798cce15a0 *man/polytrans.Rd 8be02d42d92b221c10cb99f628a6909a *man/polyval.Rd 14a8f0043c10b08c81e5fe167023ed47 *man/pow2.Rd be23c2ec43a7556246b793e40696a6fb *man/pp.Rd 905080fd4c87b75f74bb36b19882a8f5 *man/ppfit.Rd 47732dd8aec1601be86bd5350c3a912d *man/pracma-package.Rd a9be341b14772cff514afed39fb9553a *man/primes.Rd 9cc5fe95186aa22e6261858ef06d7007 *man/procrustes.Rd e0421c3ad0f8d836e74a3329ddf6d85d *man/psi.Rd e677bd6312a5473473ef447ebdd37b52 *man/qpspecial.Rd 16a63023d4110036c7af816be884357b *man/qrSolve.Rd b70a8fc880037255fed3ef8b57ffedd2 *man/quad.Rd bffd970ff564ce4c33aca5d673c1213b *man/quad2d.Rd f75804cdcb802ff1fa8f859ab1dd7b61 *man/quadcc.Rd d250071dca3cb115a3c4fa04974f7dbe *man/quadgk.Rd c5c1a0403a8b99a1afb6ede2860b7d12 *man/quadgr.Rd a7347de6e910751b63b508d854761d0c *man/quadinf.Rd 26f86eaf809847d34dc03e516ac33f57 *man/quadl.Rd ed810bd408e4943eefd151e095a0e566 *man/quadprog.Rd ab5e12394bdabd8b18daef3b8fec5c94 *man/quadv.Rd 809bcd3b9a64e1d3cc3529c59abf0cab *man/quiver.Rd b949a9f50282a92b9a2f4953f7fdc7ca *man/rand.Rd 2d91869256d76ab48ea0cf79e217fb75 *man/randcomb.Rd 2272e9e27bb6074160f7c5128b1b8afb *man/randortho.Rd 5383459d8bc2f3e1919dc423771bdc44 *man/randperm.Rd 8705d8408c5ea76fbd8141a5a714a2cf *man/rank.Rd 8cd41e03d0696d61b273da49530e4249 *man/rat.Rd 8f868bf3dfbd03959f22b00870d9e29b *man/ratinterp.Rd f8f67312f87fba0057ac58a5bd790b93 *man/rationalfit.Rd df7971c88623d7d11f9730bb5ed62f9c *man/rectint.Rd e5c988f72f8c28d7816aeab8efdea5b1 *man/refindall.Rd b7063da976c77e0a6b3803a3cfa04da6 *man/regexp.Rd dbc9c45a61da12878025a1273899c3c7 *man/regexprep.Rd bbaa5188a649e691a47c1789aeb70998 *man/repmat.Rd 1cd974a5e5920c8e5d1b80c3bbda13ff *man/reshape.Rd 80ec4df38e0634011c75e0b37caff1b9 *man/ridders.Rd 53c4d734fb140c2e495bbc2d8661dd2b *man/rk4.Rd 0c67570239c704b6a21cff4724f8a804 *man/rkf54.Rd 71741334b5b13f3b7d72a116a1322fa9 *man/rmserr.Rd d6a7e2b8ba26e1f11d461eeb93b8118a *man/romberg.Rd de633a3c1c7f9f9e11e2fd3520aca813 *man/roots.Rd b7fff77d88a02484baa87ed77030933b *man/rosser.Rd b3da2a1d5c9cdbeec4046162e9beb819 *man/rot90.Rd 23d2daac09c37553787d122855921ed6 *man/rref.Rd 0f91c57df0012344f42eca12fa2fa8fb *man/runge.Rd 6cd045e001c719ebde91ab6d6a94e2a0 *man/savgol.Rd 413f7afa073c7f7ef4f21d827200be9f *man/segm_distance.Rd df9a1b1d905f7a132b75a12a03d28cf7 *man/segm_intersect.Rd 4af43e73f89ff654b715c946b1f6a491 *man/semilog.Rd 12eb5ce4e492461c381380431a07b8c1 *man/shooting.Rd 32806e662579d953591e9677ea323ee5 *man/shubert.Rd 5916efcdba4a38e80b513f0a0d79142f *man/sici.Rd c12c339b4dd82424603e8211a1355eb4 *man/sigmoid.Rd 584273f2c399c94510d48b02837e73f5 *man/simpadpt.Rd 8cfed5790c786680e83489f911319389 *man/simpson2d.Rd 11d88fa5749b3edc2d3811058aa52834 *man/sind.Rd a5664efda77e4f1b629560b78ff0f490 *man/size.Rd 6979719d7b3dd68943be2e73816875c0 *man/softline.Rd 17dd6b373c6af05a851079833feb2eac *man/sorting.Rd 29a17025391bcfb014c398ff4e21337c *man/sortrows.Rd b5fb9dfffc948073d37b4d633864c861 *man/spinterp.Rd d0d2a2ff3f595781704ee40e3c1cf9fd *man/sqrtm.Rd 3a6f02136d4f12d82864740a78348d35 *man/squareform.Rd 51acab37df156822fef6a5d8f09e494d *man/std.Rd 29c30bc0100a966afc683cbdee85aa2b *man/std_err.Rd bb690a941a730c77d3ba34a975d5ff6d *man/steep_descent.Rd 4863d20a9f2f5b87fc99ff145d71869e *man/str2num.Rd 3f9c488f420b7236131466008ec152d0 *man/strcat.Rd 2637efd0d40950038596265e56ac48fb *man/strcmp.Rd 55bebbf63ffa0788f1d99155e73f9ef2 *man/strfind.Rd 8e768d337a93221fe499644edb581853 *man/strjust.Rd bcc9e5e78301a401fe408f5544f8c196 *man/strrep.Rd 4f658bbde9fbb2c4b14741ed7fa8039c *man/strtrim.Rd ea8f567a958245f2a77b4478381ad260 *man/subspace.Rd a932f78643285a736e358930f086ed39 *man/sumalt.Rd e4b14d3799ee7c34e0d1ea2637c31cef *man/taylor.Rd 795e0b560ef6ae6bc37f95ddd91f6e19 *man/tictoc.Rd e2f3cbba480da2dcd6657444a88a237c *man/titanium.Rd 57e64ce59a9824b113268ab0aaf5e658 *man/toeplitz.Rd 987d14179138078b158beffa12071993 *man/trace.Rd d95679fe0d204e8d5dbf8edf9e3532a6 *man/trapz.Rd 6f0017a9064392f52509d5fc16e82e9a *man/tri.Rd 408007999265cb6e9b4bbe0e126be55f *man/trigApprox.Rd 96ec0de7650171c02770cfc3d4190faa *man/trigPoly.Rd 2f093543b9d2c5b833ba3c5ea2efb4e4 *man/trigonometric.Rd 27479487491ff5dd1a6f88f6f7a7484d *man/triquad.Rd 006b1a6976dd77815117a63bf7c0c15f *man/trisolve.Rd 580b045c1ac2c33a4f58a9f722dfd33e *man/vander.Rd 84e7ad60010a3338fd2b4458b219b485 *man/vectorfield.Rd dbf5928d57d3e2977c5863ec61a92e0c *man/whittaker.Rd e4503771afe33495d500365bb031bf42 *man/wilkinson.Rd 8b99ff2c3e7370f20d7663be32f378dd *man/zeta.Rd 253f24acc2f04ea5ffe65c896e9150bf *tests/blkdiag.R 181958d609968d72ab8c36432de59e72 *tests/ceil.R 5fdb09358c2bef72f31ef633a7f8be43 *tests/chebyshev.R c1d5fa23e4d89e0313951d53bfc4dcee *tests/combs.R 5f88940c4b18cbad354270ae16518b7c *tests/compan.R adc16b618ce7db6492caf076db5d0d7d *tests/cond.R 3c3f7c4984ea090a515d5a16a8f18854 *tests/conv.R a5be4e0e35584477c7a59b40d6302c75 *tests/cross.R ddeffa055c52623a8559bf9696f4d727 *tests/crossn.R 1d108b5bab0ff262aa8f4850310344f1 *tests/deval.R 7380a3f99d180d027594fb09a723431a *tests/diag.R 0f80eb7e5256ca1807763d5dfc59f502 *tests/distmat.R dec85f2980275bc2a2dfc858322f625e *tests/dot.R b245651417852908c2d473d248fb14ad *tests/eig.R 58615264bb4617c6abe691e634174a94 *tests/factors.R 9ddc1edd5bb3e580427ac4816ec9dfb0 *tests/find.R d8ab951ffff9a2b2e68fe561ad04444a *tests/findintervals.R 0ef8f13e9f48aa68ed2d56d465fe9596 *tests/findpeaks.R 236f2918f0ef7122514cbbe93c4fc7a2 *tests/flipdim.R 44230dbbeddf7980fbd5f093c169a8c1 *tests/fnorm.R e7a87299f6fde24ac59b776681dc2561 *tests/gamma.R ae3af38ddf62ed6a0065bfc7f7a88b8b *tests/gradient.R 46c8bc49365821d344364954b9106b14 *tests/hadamard.R 9a67171a25d100f80b89e99f54d90088 *tests/hankel.R 3c87843ce357ee8b6924d8388ddfea38 *tests/hilb.R 2a7ee54066e9a2194508a8a17758666b *tests/horner.R 57831add4637d8e8281d76c120c8a839 *tests/hypot.R 36a52f00b69fd70014ac9aa57174b578 *tests/interp1.R 58b2673b037410d30125e3896369ece8 *tests/interp2.R b238e92fc4a63e2bb00a04bb33b5bcc8 *tests/inv.R 925308a8594dd2ebfa1962b629071771 *tests/isprime.R 5f52ac836dc42ea149d7312a2aa4a68e *tests/lambertW.R d2089222dc34f3b580779798d7c8f7e6 *tests/linspace.R 53f883e1a029412c3c22f237d09dbb7f *tests/magic.R 628871d8d0c2ba9f1cd8993ada8423d2 *tests/meshgrid.R 05528b857f97e81f44698e1a7c506d0b *tests/mldivide.R e79cb36b38bfa268677020f8c4d96e4e *tests/mod.R 73d06612373840c992b579e223fba123 *tests/mode.R 753c977582bf412fa1ff19af5e99e899 *tests/nextpow2.R b854f5bf0136c068a742682677e4d74e *tests/norm.R d614c1453264f7f71e7cfe5ed545276b *tests/nthroot.R 6d8b282d041296fe934263696d1b3cf2 *tests/pascal.R 84c073877df6b721de73d451f0aa49b5 *tests/pchip.R 0898b085ba91239a3ee2b96af41f248f *tests/perms.R a43318741053d5cc396e246d74f633b3 *tests/piecewise.R ee6a486eebc47ad87fcf682789968dbe *tests/poly.R 0fa613d6c6a154b786d90cf1d4df7810 *tests/polyadd.R 101f531cda5891c0d9fb11bae9912576 *tests/polyarea.R 201aaf7a18bb02701a6f501f94c02224 *tests/polyder.R a348b6c208fd8c970d3ce6f172db8226 *tests/polyfit.R b03b1e84861e45105891b191a674ab38 *tests/polyint.R ec178fcaf165e1220ac62c608ab7ac85 *tests/polymul.R 55f00618980fe5538fc0cfd4d05a3e9e *tests/polyval.R 30a52c22e56da46855ea5ade531e6bfe *tests/pow2.R e3d0eee604b3b633767871e3c6cd90c8 *tests/primes.R dcc49436591b52d9a668b58047d8b3ca *tests/quad.R 1e858a0a5c5b511ddceaff74d6b56330 *tests/quadrature.R 92fc63898bd447b95c8906eed2bb23f1 *tests/rank.R 9ccbd4aac6fb2515f5e70377fbf2669e *tests/rectint.R 96cf17fa2bf68502fce35d68dfcb4582 *tests/regexp.R e606750e8b2da61d73b6f3fd4590763e *tests/roots.R e003cd1f6518efcc4bfbc9c234caab56 *tests/size.R d643a1f1ec646d90f6992bea9cf7bfc9 *tests/std.R 0ca39d0545a8ba5f1cfd1ee6e8cc98c1 *tests/strfind.R 5d9cad0025ac590f5cfcc95db71586c3 *tests/strings.R 68ae294090618df1a69f1085ab0f9695 *tests/subspace.R 135a210ff49e55f9413179b903593482 *tests/trace.R d0cab15f1e524b68082968f60498c3a4 *tests/trapz.R c4695893e70a53121449052900b92975 *tests/vander.R c9cd9ecef61b7b0a58bafd98387b60d6 *tests/wilkinson.R