Tag Info

New answers tagged

0

You are using insufficient precision: theta2'[.8] (* -0.794774 + 0.280078 I *) Precision[.8] (* MachinePrecision *) Use exact arguments: theta2'[8/10] and get the exact result. Use N et. al. with desired precision to retrieve numeric values. N[theta2'[8/10], 10] (* -0.8874928427 + 4.596*10^-7 I *)


4

What the OP is trying to code is already in Mathematica in the form of ParametricNDSolveValue. myodessystem = ParametricNDSolveValue[{y'[x] == k1 y[x] Cos[k2 x + y[x]], y[0] == 1}, y, {x, 0, time}, {k1, k2, time}] (* ParametricFunction[<>] *) mysolve = myodessystem[1, 1, 30]; mysolve[1] (* 0.991387 *)


3

Note change at end of your function... you might also want to add checks to ensure that there was a solution so as not to return a nonsense function. myodessystem[k1_, k2_, time_] := Module[{odes, y, x, sol, myfun}, odes = {y'[x] == k1 y[x] Cos[k2 x + y[x]], y[0] == 1}; sol = NDSolve[odes, y, {x, 0, time}]; myfun = First[y /. sol]]; mysolve = ...


0

You can't do this that way, when you evaluate RunScheduledTask you are only sending a held procedure for scheduled evaluation to Kernel. But Reap[expr]: gives the value of expr together with all expressions to which Sow has been applied during its evaluation. RunScheduledTask is of course HoldFirst so Sow is not applied at this time. You can put ...


6

Couple of ways: f[x_, y_] := y*x^2 SparseArray[{i_, j_} :> f[i, j], {3, 3}] // Normal Array[f, {3, 3}] Table[f[x, y], {x, 3}, {y, 3}] (* {{1, 2, 3}, {4, 8, 12}, {9, 18, 27}} {{1, 2, 3}, {4, 8, 12}, {9, 18, 27}} {{1, 2, 3}, {4, 8, 12}, {9, 18, 27}} *) If you already have the array (say in this example a 3x3 zeroes) and you want to go over it and ...


1

This is not a complete answer, but it is too long to post in a comment. I have made some modifications in your code, but due to insufficient information given, I cannot completely correct it (I don't know economics). I will put the code here and possibly make other's work easier. boptval[stock_, time_, vol_, int_, expn_, payoff_, strike_, nas_] := ...


2

Here's something very similar to the Neat example found in the Documentation for FindShortestTour. Is this what you're asking for, or are you asking how FindShortestTour was implemented? (* grab random cities and their GeoPositions *) cities = SemanticInterpretation["US state capitals"]; locs = EntityValue[cities, "Position"]; (* find the shortest tour *) ...


1

This code from this Wolfram guide uses RandomReal[] to get 100 random points in a plane, than solves traveling salesman problem using FindShortestTour[], and in turn renders suitable drawing: With[{p = RandomReal[10, {100, 2}]}, Graphics[{Line[p[[Last[FindShortestTour[p]]]]], PointSize[Large], Red, Point[p]}]] Tho output should look like this: ...


0

I wouldn't say all functions. For example, consider f = Compile[{{x, _Real}}, x*x] There aren't any replacement rules for f in this case. DownValues[f] (* {} *)


0

Normal[ts] gives the time series as a 2-column list, which then can be exported as any other list.


0

For illustrative purposes and choosing an arbitrary initial condition: sp = StreamPlot[{deq1[[2]], deq2[[2]]} /. {x[t] -> u, y[t] -> v}, {u, -0.1, 300}, {v, -0.1, 600}]; pp = ParametricPlot[{x[t], y[t]} /. First@NDSolve[{deq1, deq2, x[0] == 100, y[0] == 100}, {x[t], y[t]}, {t, 0, 100}], {t, 0, 100}, Evaluated -> True, ...


0

The symbol _ is a shortcut for Blank[]. If you try evaluating Blank[] === True your result will be False, so your third condition can never be met. If you need an expression for your third condition that will always evaluate to True, I can think of a good one that works pretty well: Which[ x === 1, "AAA", x === 2, "BBB", True, $Failed ]


6

SphericalBesselJ[210, (1/1.5)*2*Pi*1.5*1000/40] // InputForm 0. Use higher precision input SphericalBesselJ[210, (1/1.5`20)*2*Pi*1.5`20*1000/40] // InputForm 9.4770515229477837927439`0.13632911832271324*^-16 SphericalBesselJ[210, (2/3)*2*Pi*(3/2)*1000/40] // N[#, 20] & // InputForm 9.47705152294778379274395028349340334928589`20.*^-16 ...


6

Mathematica does it internally by using BoxForm`ArrangeSummaryBox, which is quite straightforward to figure out: MakeBoxes[obj_MyObject, fmt_] ^:= Module[{o = List @@ obj, shown, hidden, icon = Graphics[{Blue, Circle[]}, ImageSize -> 70]}, shown = {{ BoxForm`MakeSummaryItem[{"Name: ", "Name" /. o /. "Name" -> Missing[]}, fmt], ...


2

I evaluated the computational complexity in the two main aspects: Time (Runtime/CPU-Time) Space (Memory) with regard to increasing i for artificial parameters: cpl=Module[{a, b, z}, Table[ a = Range[i]; b = Range[i]; z = RandomReal[{-10., 10.}]; AbsoluteTiming[MaxMemoryUsed[HypergeometricPFQ[a, b, z]]], {i, 1, 500} ]] Time complexity: ...


1

If you know the kappa values ahead of time (eg. {1,2,3,4,5} ) and the dimension of your getA matrix is 3, for example kappa = Range[5]; n=3; then use a Pure Function and Map it to the List of kappa values getA[#] & /@ kappa getW[IdentityMatrix[3], getA[#], IdentityMatrix[3]] & /@ kappa { {{2, -1, -1}, {-1, 2, -1}, {-1, -1, 2}}, ...


3

Given a sounds wave, you can read the samples, and plot part of the sounds wave fname = "ExampleData/rule30.wav"; ele = Import["ExampleData/rule30.wav", "Elements"] So the sound file contains the above elements. You can import each on its own. fs = Import[fname, "SampleRate"] You can look at first few milliseconds of the sound data = ...


3

It seems to be a bug, that manifests because of the fact that the answer could be positive or negative. If you look at the Trace of this operation, with TraceInternal -> True, you can see that it gets as far as finding the answer as a rounded version of $\pm720000\sqrt{6}$. It has candidate solutions of either Ceiling[-720000 Sqrt[6]] or Floor[720000 ...


0

I am not exactly sure, but I think it is happening because of a poor starting point (probably coming from the default algorithm) which is not giving any convergence. As a result Mathematica is giving the only possible output - the input itself. A possible alternative can be defining a starting point with FindMaximum FindMaximum[{n^2, n^2 <= ...


0

There is another possibility, and that is to differentiate an InterpolatingFunction. Here is an example of a rather poorly behaving function whose derivative we can recover by this technique. The transfer function of a Butterworth filter looks like h[s_] := 1 / (1 + 2s + 2s^2 + s^3) for s complex. The Arg of this function, which, for purely imaginary ...


2

In Mathematica v10.1 there's undocumented GeneralUtilities`ReapList function. It accepts two arguments: expression and a tag. Using it on adapted test suite from OP: Needs["GeneralUtilities`"] ClearAll[tag] ReapList[Sow[15, tag], tag] (* {15} *) ReapList[Sow[{}, tag], tag] (* {{}} *) ReapList[ Sow[{16, 17}, tag]; Sow[18, tag]; Print["hello"]; Sow[{19, ...


1

Night time of First day + (night time period times [[2;;-2]] days) + night time of Last day nightTime[{startDateTime_?DateObjectQ, endDateTime_?DateObjectQ}, {nightStartTime_?TimeObjectQ, nightEndTime_?TimeObjectQ}] := (* night time of First day + night time period \[Times] [[2;;-2]] \days + night time of Last day *) Simplify[ ...


3

d1 = {2015, 4, 1, 3, 10}; d2 = {2015, 4, 3, 18, 10}; j[d_, s_, h_] := Join[DatePlus[d, s][[1 ;; 3]], {h, 00}] abst = AbsoluteTime; l1 = DateRange[j[d1, -2, 22], j[d2, 2, 22]]; l2 = DateRange[j[d1, -1, 6], j[d2, 3, 6]]; ints = Interval /@ Map[abst, Transpose@{l1, l2}, {2}]; iu = IntervalUnion@@(IntervalIntersection[Interval[abst/@{d1,d2}], #] & /@ ints); ...


1

Edit, fixing some errors to show this "works" tend = AbsoluteTime[{2015, 4, 3, 18, 10}]; deltimed = (tend - AbsoluteTime[{2015, 4, 1, 3, 10}])/3600/24; {wholedays, fractionseconds} = {Floor[#], FractionalPart[#] 24 3600 } & @ deltimed; isnight[t_?NumericQ] := Boole[0 <= # < 6 || # >= 22] &@DateList[t][[4]]; nightfirstpartday = ...


1

If you know that x will always have 6 items then you can restrict f by f[a_List /; a \[Element] Vectors[6, Reals]] := a.x This will not evaluate the function when a has the wrong dimensions. Hope this helps.


0

f[a__] := {a}.x x = Range[6]; f[a1, a2, a3, a4, a5, a6] (* a1 + 2 a2 + 3 a3 + 4 a4 + 5 a5 + 6 a6 *) Or g = {##}.x &; g[a1, a2, a3, a4, a5, a6] (* a1 + 2 a2 + 3 a3 + 4 a4 + 5 a5 + 6 a6 *)


2

f[a_List] := a.{3, 4, 5, 6, 7, 12}; f[{1, 2, 3, 4, 5, 6}] (* 157 *) Incidentally, do not use upper-case variables, as it is likely to conflict with internal functions (such as N). I presume you know the number of components of a (i.e., you're not asking about inputting a vector of arbitrary length), since you apparently have a fixed x (of known length). ...


3

this would be a definition which does what you want for a list of rules: f[r : {__Rule}] := someFunction @@@ r and this would be one which handles the Association case: f[a_Association] := someFunction @@@ Normal[a] As mentioned by Gerli in a comment in version 10.1 one can also use KeyValueMap for the second case, for which that new function was ...


2

r = {"a" -> "1", "b" -> "2", "c" -> 3, d -> 231, "e" -> 1.25}; someFunction[key_, value_] := {key, value}; (* say *) f = someFunction @@@ # & f@r {{"a", "1"}, {"b", "2"}, {"c", 3}, {d, 231}, {"e", 1.25`}}


2

Using the generator in your post: RandomPolynomial[degree_Integer?Positive, distribution_: NormalDistribution[0, 1]] := With[{functionbody = Sum[RandomVariate@distribution #^(i), {i, 0, degree}]}, functionbody &]; Generate some polys, and their derivatives: degree = 3; var = x; number = 5; polys = ...


1

Different version of Bob Hanlon's solution: f = (1 - # &)@*(1 - # &)@(# &) (*#1 &*) f@x (*x*)


0

Just another way to look f = (1 - #) & (*your function*) g[f__] := (a f@ # + b f@f@#)& (*your arbitrary complicated function of function*) h[x_] := Simplify[g[f][x]] (*your final function*) (I just wanted to use Simplify somehow)


4

Since, Attributes[Function] {HoldAll, Protected} Use Evaluate f = Function[{x}, Evaluate[(1 - # &)@*(1 - # &)@x]] Function[{x}, x] f@x x


2

I take it you are interested in the minimum in the absolute value of the difference Abs[f[x]-c g[x]]. Otherwise, the answer is trivial: c=-Infinity. Let us define the functions: f[x_] := (-1 + x) Log[1 - x] - x Log[x]; g[x_] := Log[1 + 2 (-1 + x) x]; w[x_, c_] := f[x] - c*g[x]; and plot them: Manipulate[Plot[w[x, c], {x, 0, 1}], {c, -3, -0.1}] ...


3

Before I begin, a quick note. In the problem as stated, the optimal value of c is $-\infty$, since that makes the value of $f-(-\infty)g=f-\infty=-\infty$ (since $g<0$ for all $x\in(0,1)$). I'll instead work the problem of minimizing $|f-cg|$. First we can evaluate the Maximize statement, just to see what we get: Maximize[{Abs[f[x] - c g[x]], 0 < x ...


4

This is a good question, but unfortunately there doesn't seem to be a perfect solution. You can use ToExpression, e.g. ToExpression["1.23"]. But: (1) this gives no error checking (2) it's a serious security risk if you obtain the string from users (and it can go things go haywire in general if the string comes from an unknown source) ...


1

Here’s first code line of Stephen Wolfram’s Pi or Pie?! Celebrating Pi Day of the Century blog post: PiString = StringDrop[ToString[N[Pi, 10^2]], {2}]; Stephen converted the first 10 million digits of π to a string without a decimal point, but I’ve taken just the first 100 digits. The real number analogue of FromDigits would be: PiApproximate = ...


0

result = ReplacePart[first, Thread[Rule[Position[first, a], t]]] ListPlot[Transpose[{t, result}]]


3

first = {1 + a, 2 + a, 3 + a, 4 + a}; t = {0, 1, 2, 3}; MapThread[#1 /. a -> #2 &, {first, t}] (* {1, 3, 5, 7}*) or #[[1]] /. a -> #[[2]] & /@ Transpose@{first, t} (* {1, 3, 5, 7}*)


1

xB = {0.00, 0.076, 0.164, 0.300, 0.479, 0.638, 0.854, 0.941, 1.00}; pP = {44.0, 42.2, 39.5, 36.4, 30.4, 27.6, 22.4, 12.9, 0.00}; pT = {44.0, 66.4, 84.0, 99.8, 105.8, 108.4, 109.0, 104.5, 94.4}; iP = Interpolation[{xB, pP}\[Transpose]]; iT = Interpolation[{xB, pT}\[Transpose]]; Show[ Plot[{iP[x], iT[x]}, {x, Min[xB], Max[xB]}], ListPlot[{{xB, ...


1

Just solve for c, given your Limit-conditions: cc=Solve[ Limit[myfunc[x], x->2, Direction->-1] ==Limit[myfunc[x], x->2, Direction->1], c] (* {{c -> 2/3}} *) and apply it (myfunc[x]/.First@cc) with the result Piecewise[{{2*x + (2*x^2)/3, x < 2}, {(-2*x)/3 + x^3, x >= 2}}, 0] Hint: If you define myfunc by directly using ...


0

Seeing you got your two limits, you could just solve them like this: sol = First@Solve[8 - 2 c == 4 (1 + c)] (* c -> 2/3 *) and then myfuncC[x_] := myfunc[x] /. sol


5

myfunc[x_] := Piecewise[{{c x^2 + 2 x, x <= 2}, {x^3 - c x, True}}]; lim1 = Limit[myfunc[x], x -> 2, Direction -> -1] lim2 = Limit[myfunc[x], x -> 2, Direction -> 1] sol = c /. First@Solve[{lim1 == lim2}, c] (*2/3*) Plot[myfunc[x] /. c -> sol, {x, 1, 3}, Epilog -> {Red, PointSize[.015], Point[{2, myfunc[2] /. c -> sol}]}] ...


4

This isn't a problem you should try to solve automatically. Use good code hygiene and make sure you don't call private functions. You should (aim to) understand your code well enough that you don't get surprises like this --- you wrote it, and you know it better than anyone else. If there are surprises even to you, how will anyone else understand it?! ...


4

You can include an iterator along with the function in the mapping: k = 0; (++k; f[#]) & /@ Range[100];


2

Using NotebookWrite in this manner is really no different from manually modifying the content of an Output cell. The FrontEnd converts the cell to Input, since it anticipates the user would be interested in evaluating it afterwards. What style is used is determined by DefaultDuplicateCellStyle.


1

I have a possible work around here: Button["date", NotebookWrite[EvaluationCell[], Cell[#, "Output"] &@BoxData@ToBoxes@DateString[]]; SelectionMove[EvaluationNotebook[], Previous, Cell]; CurrentValue[Cells[NotebookSelection[EvaluationNotebook[]]][[1]], StyleNames] = "Subsection"] unforunately i could not test EvaluationBox[] because i have only ...


1

Here the answer to your question posted in your comment in following steps: 1) Retrieve Weather data and assign to dset dset = WeatherData[ "WMO44292", #, {{1956, 8, 2, 12, 0, 0}, {1957, 8, 2, 12, 0, 0}}] & /@ {"Humidity", "Pressure", "Temperature"} 2) Restructure list dset1 = DeleteDuplicates @ Flatten[#, 1] & /@ ( dset // ...


2

The default for all functions that have the option TimeZone is $TimeZone. Setting it to a different value should change it for all these functions. Unprotect[$TimeZone] $TimeZone = -0 Protect[$TimeZone] Sets the time zone to Greenwich Mean Time (GMT).


2

Lacking an example of your polynomial I did not attempt to test this extensively, but try: ClearAll[fn] fn[p_Plus] := fn /@ p fn[f_ g_] := fn[f] g + f fn[g]



Top 50 recent answers are included