New answers tagged function-construction
0
Continuing the theme that Rojo started, the main problem as I see it is that you are confounding the input to your function, the symbol name mylist, with the output of your function, a list of numbers. Since the symbol name does not change there is no reason for nesting, and you want simple iteration performed by Table:
ClearAll[update, mylist]
update[x_] ...
1
update[x_] := (x[[1]] = x[[1]]*2; x)
Attributes[update] = HoldAll;
list = Range[3];
That first evaluation of list in Nest[update, list, 5] is an issue but it's not the main issue. If that was the issue it could be solved with Nest[update, Unevaluated@list,5]. However, this would only work in the first iteration.
Nest applies the function to the result of ...
5
Indeed, Nest and NestList do not support functions with Hold attributes (as well as Fold and FoldList, etc). There were discussions of this in the past. I was able to find one such.
As far as I can tell, this is by design. What happens is that NestList (for example) maintains an internal list of intermediate results, the last of which is used in the next ...
6
Here's another way to proceed, using Derivative[], and sidestepping the use of a dummy variable:
LogDerivative[f_] := Derivative[1][Composition[Log, f]]
Test:
LogDerivative[Sin][x]
Cot[x]
LogDerivative[Gamma][x]
PolyGamma[0, x]
LogDerivative[#^3 &][x]
3/x
6
Your operator must depend on both function and variable - in analogy to D function:
logD[f_, x_] := D[f, x]/f
or an alternative definition:
logD[f_, x_] := D[Log[f], x]
Of course your variables of differentiation and in the function must agree. Test it:
logD[f[x], x]
Derivative[1][f][x]/f[x]
logD[Sin[x], x]
Cot[x]
f = x^2; logD[f, x]
...
10
A little bit more. Still not fully diagnosed, but the problem isn't due to DSolve
... :
s1 = DSolve[{x'[t] == f*x[t] (1 - (x[t]/b)) - l x[t]}, x[t], t];
s2 = DSolve[{x'[t] == e*x[t] (1 - (x[t]/b)) - l x[t]}, x[t], t];
And the problem shows up when matching the initial condition:
Solve[(x[t] /. s2[[1]] /. t -> 0) == 4/10, C[1]]
(*
{{C[1] -> ...
6
The problem can be reduced to the DSolve expressions:
DSolve[{x'[t] == a*x[t]*(1 - (x[t]/b)) - l*x[t], x[0] == 0.4}, x[t], t]
DSolve[{x'[t] == h*x[t]*(1 - (x[t]/b)) - l*x[t], x[0] == 0.4}, x[t], t]
One can see that alphabetical order appears important:
With[{a = Symbol@#},
Shallow @ DSolve[{x'[t] == a*x[t]*(1 - (x[t]/b)) - l*x[t], x[0] == 0.4}, x[t], ...
1
I think the issue is that your function U is defined only for integer r, whereas FindFit would want to sample the function at intermediate points as well. In this case, you can build the least squares by hand.
Additionally, your choice seems to be a poor fit; the vector racc decreases with its index, which makes your U increase so you won't get a good fit. ...
4
A bit more succint syntax you can reach with Dot, first define an array :
n = 10; (*choose the length of array if not defined*)
coeffArr = RandomInteger[10, n]
{2, 3, 10, 10, 9, 4, 9, 4, 6, 10}
and the result (since Power is Listable)
x^Range[0, n - 1].coeffArr
2 + 3 x + 10 x^2 + 10 x^3 + 9 x^4 + 4 x^5 + 9 x^6 + 4 x^7 + 6 x^8 + 10 x^9
...
2
Try FromDigits[]
U[r_] := ecc (1 - (FromDigits[racc, r] - Exp[-Acc (1 - rscc)])^2);
5
If you have an array of polynomial coefficients, you can use FromDigits[] in a most unconventional role:
coeffs = Range[10];
g[x_] = Expand[FromDigits[coeffs, x]]
10 + 9 x + 8 x^2 + 7 x^3 + 6 x^4 + 5 x^5 + 4 x^6 + 3 x^7 + 2 x^8 + x^9
You could also use Fold[] to implement Horner's method, if you wish:
g[x_] = Expand[Fold[(#1 x + #2) &, 0, coeffs]]
...
0
Mathematica can not Sum functions
simply
Clear["Global`*"]
A[x_] := X + 1;
B[y_] := y + 3;
C[r_] := A[r] + B[r]
Will give you error of
SetDelayed::write: Tag C in C[r_] is Protected. >>
Try making the function out summations directly, your function should look like
U[r_] := Sum[-ehh (1 - (1 - Exp[-Ahh (ra[i, j, r] - rshh)])^2), {i, 2,
5}, ...
2
You did not provide a definition of v or ra which would be helpful, but I suspect this may at least help you move in the right direction:
vhh[i_, j_, r_] /; 2 <= i <= 5 && 7 <= j <= 10 :=
-ehh (1 - {1 - Exp[-Ahh (ra[i, j, r] - rshh)]}^2)
vhh[__] := 0
vch[i_, j_, r_] /; i == 1 && 7 <= j <= 10 :=
-ech (1 - {1 - Exp[-Ach ...
4
Pick[#, Sign[(#1 - #4)] + Sign[(#4 - #7)] +
#1/(10.0 #2 + #3) + #4/(10.0 #5 + #6) +#7/(10.0 #8 + #9) & @@
Transpose@#, 1. - 2] &@ Permutations@Range@9 // Timing
(*{1.138807, {{5, 3, 4, 7, 6, 8, 9, 1, 2}}}*)
More faster version (Thanks @Michael E2):
Pick[#, Function[{a, b, c, d, e, f, g, h, i},
Evaluate[ Sign[a - d] + Sign[d - g] +
...
3
One way to speed things up is to use internally fast functions ("vectorized" ones).
Another consideration is that machine-size integer arithmetic is faster than exact rational arithmetic. If we clear denominators in the second criteria it turns out to be faster.
pickCriteria = Compile[{{perms, _Integer, 2}},
#[[1]] #[[5]] #[[6]] + #[[2]] #[[4]] #[[6]] + ...
2
Replaced by one equivalent Pick, but the net result is a slowdown ...
Pick[#, #1 < #4 < #7 && #1/(10 #2 + #3) + #4/(10 #5 + #6) + #7/(10 #8 + #9) == 1 & @@@ #] &@
Permutations@Range@9
1
Plot[IntImpTri[0, 4, r], {r, -1, 5}, Exclusions -> None]
The problem is usually caused by discontinuities in the derivatives
5
f = {# &, 3*# - 5 &, 0.1*#^2 &};
xvalues = Range[0, 500, 2.5];
t1 = Through[f[xvalues]] /. x_ /; x < 0 -> 0;
ListPlot[t1, DataRange -> {0, 500}]
2
I would simplify your code a bit, merging everything into the Map statement, and move everything into a function, as follows:
process[func_, xvals_] :=
Block[{points},
points = Map[ With[{val = func@#}, UnitStep[val] val]&, xvals];
Transpose[{xvals, points}]
]
and then for your functions, you can simply run
process[func1, Range[0, 500, 2.5]]
...
3
How about:
apply[func_] := Module[{}, xvalues = Range[0, 500, 2.5];
points1 = Map[func1, xvalues];
Do[If[points1[[i]] < 0, points1[[i]] = 0], {i, 1, Length[points1], 1}];
table1 = Transpose[{xvalues, points1}]];
Now you call the function apply with your desired funcX as an argument
apply[func1]
Or you can automate this by defining
...
4
If the question is about converting general math-book expressions to pure functions, you could use something like
SetAttributes[convert, HoldAll];
convert[expr_, vars_List] :=
With[{variables = Unevaluated@vars},
Block[variables,
Evaluate@(Hold[expr] /. Thread[vars -> Slot /@ Range@Length@vars]) & // ReleaseHold
]]
To apply,
...
4
I know for me, I spent years using Matlab (or should I say, a toolbox-based computational system), where there is a trick called vectorization: you turn almost everything (ifs, ands, sums, products...) into simple vector commands. Doing this with your function is pretty natural since you've already defined the entries in terms of two vectors. You take the ...
2
In my continuing mission to provide smartass answers, you can do, for example:
u = {-3, 3}; v = {1, 5};
d = Function[{u, v},
((Abs[u[[1]]] - Abs[v[[1]]])^2 + (Abs[u[[2]]] - Abs[v[[2]]])^2)^(1/2)][u, v]
I think the reason why it's suggested to convert to pure functions is for performance, otherwise I don't think I'd bother. But maybe there are other ...
6
In those more complicated cases consisting of multiple steps, using Composition clears things up for me while still retaining a pure functional style. In your example of calculating the distance between two points in 2D i would write:
u = {-3, 3}; v = {1, 5};
Composition[Sqrt, #.# &, Subtract][u, v]
(* 2 Sqrt[5] *)
or as rm -rf pointed out you can ...
0
The solution to this problem is to use := instead of = with the function definition so that it is not evaluated immediately.
2
Your own formula can be refactored in a more concise form:
f1 = With[{c = +##/2}, c + (# - c).{{0, -1}, {1, 0}} & /@ {##}] &;
+##/2 is a "trick" that here is equivalent to Mean[{#, #2}]
the function needs to be applied with @@@ rather than /@
A shorter function can be written using Cross, similar to what J. M. used:
f2 = {+##, # - #2}/2 ...
2
Had Rotate[]/RotationTransform[] not been available, here's a possible alternative:
BlockRandom[SeedRandom[123, Method -> "MKL"]; (* for reproducibility *)
segs = Arrow[RandomVariate[NormalDistribution[], {5, 2, 2}]]];
Graphics[{{Blue, segs},
{Red, segs /. s_?MatrixQ :> With[{m = Mean[s]}, m + Cross[# - m] & /@ s]}}]
5
data = RandomReal[1, {5, 2}]
Whole rotation
Graphics[{Line[data], {Red, Rotate[Line[data], Pi/2]}}]
Single segment rotation
Graphics[{Line[data], {Red, Rotate[Line[#], Pi/2]} & /@ Partition[data, 2, 1]}]
9
Something along the lines of Rotate[Line[pts], angle, Mean[pts]]:
g = Graphics[Line[{{1, 1}, {2, 2}}]];
rot = l : Line[pts_] :> Rotate[l, Pi/2, Mean[pts]];
Show[g, g /. rot]
I believe that Rotate and family are Graphics/Graphics3D directives which are only processed when they are rendered. If you need to access actual rotated values of the points, ...
11
It is of course possible to redefine functions within loops in Mathematica. You are actually just missing a semicolon at the right place for your code to work as intendend:
For[i = 1, i <= 5, i++,
f[x_] := Sin[x]^2;
Print[{i, f[i]}]
]
It's probably worth noting (as Jacob did in his comment) that the semicolon is just a shortcut for a ...
9
I think you only forgot a comma. Try:
For[i = 1, i <= 5, i++, {f[x_] := Sin[x]^2, Print[{i, f[i]}]}]
this gives your desired output.
If I were you, I would not define a function in a For Loop (can be time consuming). And, if possible, I would work with a Table because this works faster too.
So do something like:
f[x_] := Sin[x]^2;
Table[{i, f[i]}, ...
4
Suppose your data is formatted as following:
data = Table[{x[t], y[t]}, {t, 0, 1, .2}]
{{x[0.], y[0.]}, {x[0.2], y[0.2]}, {x[0.4], y[0.4]}, {x[0.6], y[0.6]}, {x[0.8], y[0.8]}, {x[1.], y[1.]}}
You can use this symbolic "data" to peep into the FindFit to see what does the NormFunction take as its argument (as J.M. said (and the documentation), it's the ...
2
OK, I am stupid. ListCorrelate is what I want, indeed. I just have to use the correct parameters.
acf = norm2 ListCorrelate[int, int, {1, 1}, 0]*norm1 -1;
where norm1 and norm2 give me the normation I need and are defined as
norm1 = Table[1/(Deltat + 1 - m), {m, 0, Deltat}];
norm2 = 1/Mean[int]^2;
Thanks to Bill S, RunnyKine and Daniel Lichtblau ...
4
Note that in Mathematica there is a difference between (-1)^k and -1^k
This should solve the problem in this case.
4
Note, this can be solved in general form. Start as
RSolve[{G[n, k] == G[n + 1, k - 1] + G[n + 2, k - 2]}, G[n, k], {n, k}]
You have two unknown functions C(1)[x] and C(2)[x] that you can find using your boundary conditions.
Apply your initial conditions G[n,0]:
A[n_] = C[1][n] /.
Solve[n == (-(1/2) - Sqrt[5]/2)^n C[1][n] + (-(1/2) + Sqrt[5]/2)^
...
5
You can always define the recursive function yourself and use memoizing to speed up computation:
g[n_, 0] := g[n, 0] = n;
g[n_, 1] := g[n, 1] = n^2;
g[n_, k_] := g[n, k] = g[n + 1, k - 1] + g[n + 2, k - 2];
Table[g[n, k], {k, 0, 10}, {n, 0, 10}] // TableForm
0
As Daniel suggests, use ListCorrelate, It works very quickly:
r = RandomReal[{-1, 1}, 10^6];
ListCorrelate[r, r] // Timing
takes less than 0.02 seconds. You will want to read the documentation carefully to understand how to scale it as you desire.
1
Just for fun here is a way to pass the reference as a string
(I got this idea from @Leonids answer, but I'm not sure it brings anything useful over the injector pattern):
Here is the code:
ClearAll@PassByOptionStr;
Options@PassByOptionStr={"List"->None};
PassByOptionStr[opts:OptionsPattern[]]:=
ToExpression[OptionValue["List"],InputForm,
...
7
This is a case for injector pattern:
PassByOption[opts : OptionsPattern[]] :=
OptionValue["List"] /. Hold[l_] :> CheckboxBar[Dynamic[l], Range@Length@l]
You can check that this works with this change.
As an alternative, you can by-pass the use of Hold and clever tricks like the above, by using the longer form of OptionValue:
...
1
This seems to do the job :
ClearAll@PassByOption;
Attributes[PassByOption] = {HoldFirst};
PassByOption[opts___] :=
With[{list = Hold["List"] /. Unevaluated[{opts}],
length = Range[Length["List" /. {opts}]]
},
CheckboxBar[Dynamic[list], length] /. Hold[x_] -> x
];
aList = {1, 2, 3, 4, 5};
PassByOption["List" -> aList]
...
3
I think you can do like this:
f[{x_, y_}] := {(2 x)/(1 + x^2 + y^2), (2 y)/(
1 + x^2 + y^2), (-1 + x^2 + y^2)/(1 + x^2 + y^2)}
for points:
Manipulate[
Graphics3D[{{Black, PointSize[Large], Point[{0, 0, 1}]}, {Black,
PointSize[Large], Point[Append[pt, 0]]}, {Pink, PointSize[Large],
Point[f[pt]]}, {Opacity[0.2], Sphere[]}, {Opacity[0.2],
...
2
In fact, even NestList[] is not needed, since Mathematica has MatrixPower[]:
NestList[{{1, 2}, {2, 5}}.# &, {1, 1}, 5]
{{1, 1}, {3, 7}, {17, 41}, {99, 239}, {577, 1393}, {3363, 8119}}
Table[MatrixPower[{{1, 2}, {2, 5}}, k, {1, 1}], {k, 0, 5}]
{{1, 1}, {3, 7}, {17, 41}, {99, 239}, {577, 1393}, {3363, 8119}}
MatrixPower[] can even be used to ...
Top 50 recent answers are included
