Tag Info

New answers tagged

4

The following works for your curve: points = {{1, 4}, {.5, 6}, {5, 4}, {3, 12}, {11, 14}, {8, 4}, {12, 3}, {11, 9}, {15, 10}, {17, 8}}; deg = 3; pointsCLOSE1 = Join[points, points]; n = Length@pointsCLOSE1; knotsCLOSE1 = Range[0, 1, 1/(n + 1)]; ParametricPlot[deBoor[pointsCLOSE1, {deg, knotsCLOSE1}, t], {t, deg/(n + 1), 1}, Axes ...


10

Don't do this. You should never ever need this. Instead, define f[x_, algorithm_] with a flag for which algorithm to use. This is roughly how all built-in functions work, though they usually use Options instead. Same principle, though. For example, say condition were 5>6, and you wanted to perform the Tarragon transform if condition were true, and the ...


2

Use the function: "EventHandler", just like follows: reportDate = Today; a = Dynamic[ With[{date = Interpreter["Date"][reportDateInput]}, If[DateObjectQ@date, reportDate = date, reportDate]], TrackedSymbols :> {reportDateInput}]; b = InputField[ Dynamic[reportDateInput, {None, With[{date = Interpreter["Date"][#]}, ...


0

Not efficient, just showing that Mathemtica can do it from "first principles" Reduce[a + b + c == 91 && And @@ Thread[0 <= {a, b, c} <= 51] && Exists[Element[{aa, bb, cc}, Integers], 2 aa + 1 == a && 2 bb + 1 == b && ...


4

Ah, came across this from the "related" bar, time for a necro :-} Here's a direct and fast one-liner: numSST[t_, s_] := Block[{p = Normal[Times @@ (1 + x^s) + O[x]^(t + 1)], x = 1}, p];


3

I save notebooks with multiple GUIs as CDF files and give users CDFPlayer to install. I have code in the notebook but hide it by collapsing the cells around the GUI that I want the user to see (of course the user can open it and sometimes does by accident). For your particular problem you could write in your notebook something like: PopupWindow[ "Plot ...


1

At the moment the LUM function as written can't be used because it depends upon a number of global variables (h, me, k, Tcmd ...) that you have not supplied. However, in order to produce a list of {x2, LUM[x1,x2]} pairs this can be done as follows. Scalar Assume x2List is the list of values that you want to evaluate and you want to evaluate LUM at a ...


1

Here are a couple of options: You can write a C wrapper function that calls your Fortran code, and use WSTP to export the C function to Mathematica. It is relatively straightforward to mix Fortran and C. gfortran is one free compiler. The procedure for linking the compiled C and Fortran object files will depend on your platform, see for example this ...


15

One approach I've started to become fond of, apart from Plot[]-based approaches, involves the Chebyshev expansion of a function, followed by the construction of the corresponding "colleague matrix" (a matrix whose characteristic polynomial is the Chebyshev series previously determined), and then the computation of the colleague matrix's eigenvalues, which ...


1

This is very similar to a common problem that many symbolic Mathematica functions share, e.g.: Solve[2*x-5==15,x] and as can be seen from the example the standard way to solve that is to pass such symbols which are to be used as formal symbols as extra argument(s). As you guessed in your comment the most direct way to implement that would be something ...


17

First, it might be worth pointing out that in recent versions of Mathematica, Solve and NSolve are quite strong at solving equations with standard special functions. With[{f = BesselJ[1, #^(3/2)] Sin[#] &}, solvesol = x /. Solve[{f[x] == 0, 25 <= x <= 35}, x]; Plot[f[x], {x, 25, 35}, MeshFunctions -> {# &}, Mesh -> {solvesol}, ...


12

The first approach is to evaluate the function at equidistant points, and look for sign changes. The distance between two sampled points, dx, is an input to the function. When a sign change happens, use FindRoot, which is constrained to look for the root only between the two points that encompass the sign change. The function accepts all the Options that ...


1

Maybe try If[! TrueQ[SQLConnectionUsableQ[XxSQLConnection]], ...


4

According to the solution of xzczd that dealing with the calculation of $$N_{i-p,p}(u_0),B_{i-p+1,p}(u_0), \cdots, N_{i,p}(u_0)$$ I mimic this strategy to calculate all the values of Berstern basis function of degree $n$ $$\color{blue}{B_{n,0}(u_0),B_{n,1}(u_0), \cdots, B{n,n}(u_0)}$$ AllBernsteinBasis[n_, u0_] := Nest[MovingAverage[ArrayPad[#, 1], {u0, ...


14

After some amount of effort, I managed to come up with an implementation of O'Neill's "XSH-RR" family of permuted congruential generators. The following covers the 8-, 16-, 32-, and 64-bit generators, and the mcg, oneseq, and setseq variants. (I'll leave the modification to handle the unique variant as an exercise for the interested reader.) A similar ...


7

Well, to be honest, despite I've been using Mathematica for 3 years, I'm getting more and more confused about what's functional programming, but the following solution is at least more elegant and faster than yours: searchSpan2[knots_, u0_] := First@Ordering[UnitStep[u0 - knots], 1] - 1 NonzeroBasis2[p_, u_, u0_] := With[ {i = searchSpan2[u, u0], ...


5

For the auxiliary fuction searchSpan[] , which came form the following algorithm of The NURBS Book. where $U=\{\underbrace {a,\cdots ,a}_{p+1},u_{p+1},\cdots u_{m-p-1},\underbrace {b,\cdots,b}_{p+1}\}, \quad n=m-p-1$ Here is a rule-based solution that I implemented according to The Toad's answer NonzeroBasis[{deg_, knots_}, u0_] := Module[{coeff, i, ...


13

I just followed through with the tutorial "Defining Your Own Generator". Start with provided, a little tweaked functions. The key trick is to ensure that the bit-expandable Mathematica integers are of the size of relative machine unsigned integers. I use BitAnd with mask to accomplish that: pcgRandomR[state_, inc_] := Module[{ newstate, xorshifted, rot, ...


5

How can I recreate this sort of functionality with my own objects and functions? Are there any methodologies for writing down-values of symbols like this? If you want to know how to get a similar output format, here's a silly toy example: (* The icon isn't really that important *) icon = Plot[Sin[x], {x, -5, 5}, Axes -> False, Frame -> True, ...


6

URLDecode and URLEncode were introduced in Mathematica 10.0: url = "https%3A%2F%2Fwww.google.co.uk%2Fimages%2Fsrpr%2Flogo4w.png"; URLDecode[url] (*"https://www.google.co.uk/images/srpr/logo4w.png"*) The symbol definition can be accessed as follows, which is scarily close to @Guesswhoitis's code above. URLDecode[url]; Unprotect[URLDecode]; ...


2

As an afterthought to my comment - if speed is important, this should handily beat existing answers, particularly on larger cases: Fold[If[#2[[1]] < #1[[-1, 1]], #1, Append[#1, #2]] &, {First@rawdata},Rest@rawdata] and this will be even faster: FixedPoint[Pick[#, UnitStep@Differences[Prepend[#[[All, 1]], 0]], 1] &, rawdata] finally, fastest ...


2

I gave a method for handling this kind of problem in this previous answer. Here I show its application to your problem. expToF[exp_, vars : {(_Symbol | h_Symbol[_Integer]) ..}] := With[{body = exp /. Thread[Rule[vars, Slot /@ Range@Length[vars]]]}, Function[body]] calculateDerivativeAt[xpr_, var_, val_] := Derivative[1][expToF[xpr, {var}]][val] ...


1

Using ReplaceRepeated (//.) data1 = {{611.011, 1008}, {611.062, 1077}, {611.114, 1193}, {610.958, 894}, {611.009, 1621}, {611.061, -166}, {611.112, 704}, {611.164, 131}, {611.215, 1306}, {692.637, 6394}, {692.688, 6369}, {692.739, 6664}, {692.328, 6790}, {692.379, 7378}, {692.431, 5761}, {692.482, 6750}, {692.533, 6348}, {692.584, 7535}, ...


4

r1 = Pick[r, Thread[# >= FoldList[Max, #]]] &@r[[All, 1]] ListLinePlot@r1


4

The reason for your problem is the automatic renaming that Mathematica makes in cases where the names would clash. Let me give a very basic example (parenthesis for clarity; not required): assign[rhs_] := (f[x_] := rhs) What happens when you call assign[x^2] is that rhs contains the pattern variable x and Mathematica does a renaming so that no bad things ...


1

I'm not sure how general this is, but it works here. Add another argument stating what the variable will be. Then replace the variable with a local variable inside your block. calculateDerivativeAt3[func_, var_] := Block[ {f, fprime, blkVar}, f[blkVar_] = (func /. var -> blkVar); fprime = Derivative[1][f]; fprime[3] ] ...


1

Ok, so this is the solution: A[m_, k_] := For[i = 1, i <= m, i++, For[j = 1, j <= k, j++, A[i, j] = If[i <= 0, 0, If[(i == 1 || i == 2) && j == 2, 1, If[OddQ[i]; j == 1, 1, If[! OddQ[i]; j == 1, 0, If[j == 2, A[i - 2, 2] + A[i - 3, 2], If[i <= j, Fibonacci[i], False]]]]]]]] I ...



Top 50 recent answers are included