New answers tagged functions
0
Probably this should work:
ClearAll[f]
f[expr_ /; Cases[expr, F[x_] -> x, ∞, Heads -> True] ==
-Cases[expr, G[x_] -> x, ∞, Heads -> True]] := 0
f[expr_] := expr
Some testing:
f[kk[X]@F[X]@rr[X]@G[-X]] = 0
f[kk[X]@F[X]@rr[X]@G[-Z]] = kk[X][F[X][rr[X][G[-Z]]]]
f[F[X]@rr[X]@G[-Z]@zz[w]] = F[X][rr[X][G[-Z][zz[w]]]]
f[F[X]@rr[X]@G[-X]@zz[w]] = 0
f[...
1
You can use the new in M10 function FunctionRange to do this:
FunctionRange[(3 Sin[x]-3)/(2 Cos[x]+10), x, y] //Simplify
-5/8 <= y <= 0
1
Just add a 2nd definition for transformationMatrix
x[r_, theta_] := r*Cos[theta]
y[r_, theta_] := r*Sin[theta]
transformationMatrix[r_, theta_] =
{{D[x[r, theta], r], D[x[r, theta], theta]},
{D[y[r, theta], r], D[y[r, theta], theta]}};
transformationMatrix[{r_, theta_}] := transformationMatrix[r, theta]
Then
transformationMatrix[{0.3, 0.5}]
...
2
Here we can use function Texture[]. Note that function Arg[f] is discontinuous, so there are two sectors without coverage. Create a texture
texture[l_, m_] :=
DensityPlot[
Arg[SphericalHarmonicY[l, m, \[Theta], \[Phi]]], {\[Theta], 0,
Pi}, {\[Phi], 0, 2 Pi}, ColorFunction -> Hue, PlotPoints -> 200,
Frame -> False]
Now use this to cover
...
5
Let's look at a simpler example:
makeFunc[body_] := Function[{x}, body]
makeFunc[x^2]
(* Function[{x$}, x^2] *)
As you've correctly identified, the problem is that the arguments of Function are renamed. Interestingly, this replacement is performed during the evaluation of the definition of makeFunc, not as part of the evaluation of Function[…]: The ...
0
At any rate, changing up the functions a little gives the expected result.
line[len_, x0_: 0, y0_: 0, "r"] := Table[{rx, y0}, {rx, x0, x0 + len - 1}]
line[len_, x0_: 0, y0_: 0, rc_?Except["r"]] := Table[{rx, y0}, {rx, x0, x0 + len - 1}]
bloc[lenx_, leny_, x0_: 0, y0_: 0] := Block[{i = y0}, Nest[Level[Append[#, line[lenx, x0, i++, "r"]], {-2}] &, {}, ...
0
Another option
f[x_, y_] := x^3 + y^2 - 30*x*y - 2;
g[x_, y_] := x*Sin[x + y] + 6*y
h[x_, y_] := (x^3 + y^3)/(x^2 + Exp[y/100]);
pointsf = Table[f[x, y], {x, -1, 1, 0.1}, {y, -1, 1, 0.1}] // Flatten;
pointsg = Table[g[x, y], {x, -1, 1, 0.1}, {y, -1, 1, 0.1}] // Flatten;
pointsh = Table[h[x, y], {x, -1, 1, 0.1}, {y, -1, 1, 0.1}] // Flatten;
pointsf // ...
3
ClearAll[f, x, y, z, r]
f[x_, y_, z_] := Cos[x] + Cos[y] + Cos[z]
x[t_] := {t, 0, 0}
y[t_] := {1, t, 0}
z[t_] := {1, 1, t}
r[t_] := {t, t, t}
You can use
Through[{x, y, z, r}@t]
or
#[t] & /@ {x, y, z, r}
to get
{{t, 0, 0}, {1, t, 0}, {1, 1, t}, {t, t, t}}
and Apply f at level 1 (@@@) to the resulting list:
funcs = f @@@ %
{2 + Cos[t], 1 + Cos[1] +...
4
It's hard to be sure from your question, but you might just be looking for Plot:
f[x_, y_, z_] := Cos[x] + Cos[y] + Cos[z]
x[t_] := f[t, 0, 0]
y[t_] := f[1, t, 0]
z[t_] := f[1, 1, t]
r[t_] := f[t, t, t]
Plot[
{x[t], y[t], z[t], r[t]},
{t, 0, 1}
]
1
Posting code rather than images helps people providing answers.
There are syntax errors in the image of the code. sin should be Sin.
Here is an approach defining functions (as suggested by @Alan) and using Tuples, though Outer and matrices could be used.
The solution to the first question can be plotted to confirm result. I leave the second question to OP....
4
In Mathematica you cannot modify the values of parameters to a function.
Try using local copies of the values, which you can modify, and see if that works for you.
f[X_Integer] :=Module[{j, x, xX}, j = 2; x = {}; xX = X;
While[xX > 0, AppendTo[x, Mod[xX, j]]; xX = Quotient[xX, j]; j++]; x];
f[13]
4
Maybe you are asking for this?
h[n_] := Block[{i, j, g, f},
f = 0;
For[i = 1, i <= n, i++,
g = 0;
For[j = 1, j <= n, j++, g = g + i*j];
f = f + g;
];
f
]
However, easier and more efficient ways would be
h[n_] := Sum[i j, {i, 1, n}, {j, 1, n}]
or
h[n_] := Total[Range[1, n]]^2
or
h[n_] := (n (n + 1)/2)^2
6
This functionality is included in the FindMaxima, FindMinima & FindExtrema functions in my EcoEvo package (the continuous part is based on this answer by @DanielLichtblau).
Import["https://raw.githubusercontent.com/cklausme/EcoEvo/master/EcoEvo/EcoEvo.m"]
(* ... or install with: *)
(* PacletInstall["https://github.com/cklausme/EcoEvo/releases/download/...
6
Here is your list and its interpolation. I only made the interpolation smoother:
rA = List[{0, 0.727578}, {0.4, 0.73179}, {0.8, 0.773248}, {1.2,
1.342248}, {1.6, 0.987746}, {2, 0.791317}, {2.4, 1.11788}, {2.8,
0.996614}, {3.2, 0.938749}];
f = Interpolation[rA, InterpolationOrder -> 3, Method -> "Spline"];
Let us plot it:
Plot[f[x], {x, 0, ...
5
$Version
(* "12.0.0 for Mac OS X x86 (64-bit) (April 7, 2019)" *)
data = Table[{x, N[x Sin[x]]}, {x, 0, 4, .3}];
FindFormula does not necessarily give a consistent result. Its algorithms make use of a random seed and as the seed evolves so can the results. For example,
Table[FindFormula[data, x], {10}]
(* {1. x Sin[x], x Sin[x], x Sin[x], x Sin[Abs[x]], ...
2
Replace Graphics[...] with
Labeled[Graphics[{Thickness[t],
Table[{vHues[[i]], hea[mPositions[[i]]*s, vSizes[[i]]^e]}, {i, n}]},
ImageSize -> {350, 350}],
Style["Happy Wedding", 40, Hue[0.5/6], FontFamily -> "Mistral", Background -> White],
Top]
0
Perhaps generate a little extra and truncate:
ClearAll[Chebya];
Chebya[{x_, y_}, n_, a_] :=
Total@Take[
Flatten@Table[
a[i - j, j]*ChebyshevT[i - j, x]*ChebyshevT[j, y],
{i, 0, 1/2 Sqrt[9 + 8 n]}, {j, 0, i}], n + 1]
Examples:
Chebya[{x, y}, 0, a]
Chebya[{x, y}, 1, a]
Chebya[{x, y}, 2, a]
Chebya[{x, y}, 3, a]
(*
a[0, 0]
a[0, 0] + x a[1, 0]
a[0,...
1
For some values of a and b there is no solutions in the range 0<x<1, so solh[a_, b_] shows {x, x}, hence further errors. You can change this to:
solh[a_, b_] :=
With[{sol = NSolve[{h[x, a, b] == 0, 0 < x < 1}, x][[;; , 1, 2]]},
If[sol != {}, MinMax[sol], {0.00011, 0.99989}]];
Now in case of no solutions due to restrictions on x the ...
3
Clear["Global`*"]
f[y_] = (y^4 - 1) (Coth[2 y] - 1/Sinh[2 y])/(y^7 - 3 y^4);
Graphically, the inverse is
ParametricPlot[{f[y], y}, {y, -10, 10},
Frame -> True,
FrameLabel -> (Style[#, 14, Bold] & /@ {x, y}),
AspectRatio -> 1/GoldenRatio]
InverseFunction will provide one branch
g[x_] := InverseFunction[f][x]
Plot[g[x], {x, -0.1, 0.15},
...
0
Clear["Global`*"]
Format[x[n_]] := Subscript[x, n]
The form that you request implies that the length of the list is known. If the length is known, then you can use Part to reference ("name") the individual elements of the list.
f[x_List?(Length[#] == 3 &)] := (x[[1]] + x[[2]])/x[[3]]
f@Array[x, 3]
f@Array[x, 5]
Or if the length is at least three,
...
2
Maybe easiest to give a definition for your special case, in addition to your general definition.
B[x_, y_] := x + y/x
B[0, 0] := 0
0
Module 1V : Optimization the Challange September 2019 "Tester" Probabilty Value of one BankNotes selected.
AliceBob = Permutations[Range[0, 99], {2}]; Label[begin]; Bank =
DialogInput[{name = {}},
Column[{"BankNotes", InputField[Dynamic[name], String],
Button["Proceed", DialogReturn[name], ImageSize -> Automatic]}]]; Bank =
Reverse[{...
0
Module III : optimization the Challange September October 2019, Probabilty Value of BankNotes selected.
AliceBob =
Permutations[Range[0, 99], {2}]; HyBankNotes = 65; BankNote = {}; BankNotes =
Subsets[Range[2, HyBankNotes], {4}]; BankSave =
Select[BankNotes, #1[[1]] == 2 && 4 <= #1[[2]] <= 12 &&
8 <= #1[[3]] <= 16 &...
0
Module II "Screen Monitor to show progress value" : optimization the Challange IBM Ponder this September / October 2019 Probabilty Value of BankNotes .
g1 = {}; g = ""; g3 = 0; NSolution2 = 9900; {Solution September,
DynamicModule[{s = {{5, 30}, {1, Infinity}}},
Deploy[Style[
Panel[Grid[
Transpose[{{Style["Solution Banknotes", ...
0
Module 1 "Functions" : The First optimization problem is to find Functions called "Notes1,Notes2... " such that Functions Minimize All the possibility for diffferentes Banknotes. And prepare variables "s11,s12,.s011.." for optimization the Challange in the Second Modules.
Notes1[d01_, d02_, d03_, d04_, d05_, n0p_] :=
Module[{d1 = d01, d2 = d02, d3 = ...
0
The September question was extended on october 2019:
http://www.research.ibm.com/haifa/ponderthis/challenges/October2019.html:
Let's assume that Alice and Bob have two (possibly the same) integer amounts of money, uniformly distributed in the [0,99] range with a minimal number of banknotes.
Using the standard US dollar banknotes denominations of 1, 5, 10, ...
5
Internal`WithLocalSettings
This function (ref#1, ref#2, ref#3) can be used to ensure that some clean-up code will always be executed, even if an abort or other non-local exit occurs within some protected code. To illustrate:
Internal`WithLocalSettings[
Print["opening a file"]
, Print["doing something with the file"]
; Abort[]
; Print["never gets here"]
,...
6
The problem with using Names and Attributes is that sometimes the symbol doesn't acquire the attribute until it is used. For instance:
listable = Select[Names["System`*"], MemberQ[Attributes[#], Listable] &];
MemberQ[listable, "FresnelC"]
False
Use FresnelC:
FresnelC[{1, 2, 3}]
{FresnelC[1], FresnelC[2], FresnelC[3]}
Now, check the attributes:
...
2
If you're before v10.3, then only the first syntax is correct. For more information check:
Why does Table behave differently in Mathematica compared to WolframCloud?
BTW this syntax change causes problem in certain cases:
Unexpected behaviour from Table[]
5
The list of functions with the Attributes Listable in the System context
listable = Select[Names["System`*"], MemberQ[Attributes[#], Listable] &];
Length @ listable (* Version 12.0.0 *)
340
Short[listable, 10]
{Abs, AbsArg, AiryAi, AiryAiPrime, AiryAiZero, AiryBi, AiryBiPrime,
AiryBiZero, AlgebraicIntegerQ, AlgebraicNumberDenominator,
...
6
Notice the y-axis range of the data (~20000), compared to the plot of the model (~0.005) . If you add an amplitude parameter to the model, it works much better.
peakresponse[a_, β_, e1_, e2_] :=
a (Abs[β*e2*π])^(-1/2)*Exp[(-(e1 - e2)^2/(2*β*e2))]
nlmbeta =
NonlinearModelFit[databeta, peakresponse[a, β, e1, e2],
{{a, 3000000}, {β, 80}, {e2, 100}}, ...
1
Clear["Global`*"]
Define the variables using an indexed variable
n = 3; (* change as desired *)
var = Array[x, n];
Define the function
Evaluate[f @@ var] = Sqrt[Total@var^2]
(* Sqrt[(x[1] + x[2] + x[3])^2] *)
Taking the partial derivatives
D[f @@ var, Sequence @@ var]
(* (3 (x[1] + x[2] + x[3])^3)/((x[1] + x[2] + x[3])^2)^(5/2) - (
3 (x[1] + x[2] + ...
1
Plot[ReIm[(-2 + I x)^7 - 5 (-2 + I x)^4 + 3 (-2 + I x)^2 +
6 (-2 + I x) - 4], {x, -2, 2}]
0
Just a slightly compact way of Bob Hanlon's answer (which I voted for). Note ContourPlot frames and uses Tooltip. The aesthetics and control of Legended may be preferred.
cons = {x >= 5, y >= 8, x + 2 y <= 64, x + y <= 40};
eq = cons /. {(a_ >= b_) :> (a == b), a_ <= b_ :> a == b};
Show[RegionPlot[lab = Fold[And[#1, #2] &, cons],...
16
Actually, I want the output to be {} if there is anything wrong with the argument.
For this I recommend one or more definitions with patterns that only match a valid argument, and a fall-through definition for anything else. For example if the argument should be a nonempty list of integers:
(* primary definition *)
func[arg : {__Integer}] := Mean[arg]
(*...
4
One way is to make some definitions
foo[arr_] := {}
foo[{}] := {}
foo[arr_List] := "ok"
Mathematica will automatically pick the correct definition to use.
0
An important problem seems to be Sum with the j symbols. The following modification makes the code faster:
QNlalternative2[NN_, l_, f_] := Module[{s, wz, w, z, lvec},
s = 0;
Do[wz = Table[weightsNodesQ1l@lvec@i, {i, NN}];
w = Table[wz[[i]][[1, All]], {i, NN}];
z = Table[wz[[i]][[2, All]], {i, NN}];
s = s + Total[
Flatten[...
1
I'm not sure if Mathematica can help you find the closed form result directly, but you can generate examples for given n as follows.
Define a generic function of an arbitrary number of variables by using a single dummy variable x
f[0][x]
the first entry 0 will keep track of derivatives and shows that no derivatives have been taken yet.
Then, define a ...
3
If I understand correctly your question, you need the prime common factors: in such a case, see codes below.
Intersection[FactorInteger[40131][[;; , 1]],
FactorInteger[41405][[;; , 1]]]
or
Select[Divisors[GCD[40131, 41405]], PrimeQ]
12
Besides the reasons mentioned by @Szabolcs, there's a second advantage of the first method: It is easier to control when evaluation happens.
With vtx := …, evaluation happens as soon as the symbol appears (as long as you're not using stuff with Hold attributes/Unevaluated)
With vtx[] := …, you can pass around vtx without having to worry about evaluation. ...
12
The reason to use 1. is readability. There is no difference in function or performance.
Simply because of established convention, most people when they see f[vtx], they assume that vtx is "a variable", i.e. if it is evaluated twice, it will give the same result both times. vtx[] looks like "a function call", so people will expect that a second evaluation ...
0
Please consider the following:
Ov[alpha_, beta_, RA_, RB_, LA_, LB_] := Module[{EAB, s, ss},
(*Initial Conditions*)
s[i_, 0, 0] := 1;
s[i_, 1, 0] :=
-(RA[[i]] - ((alpha*RA[[i]] + beta*RB[[i]])/(alpha +
beta)));
(*Recurrence Index*)
s[i_, a_, 0] :=
-(RA[[i]] - (alpha*RA[[i]] + beta*RB[[i]])/(alpha + beta))*
s[i, a - ...
2
Your initial sum is equivalent to:
Sum[zb^n z^m (2j)! (2j-m)/(m! (2j-m)!) KroneckerDelta[n, m+1], {n, 0, 2j}, {m, 0, 2j}]
where I carried out the inner product by hand. Now, rather than trying to compute the double summation directly, one can do the sum in stages:
s = Assuming[
0 <= m <= 2j-1 && j>0 && (m|j) ∈ Integers,
...
1
This is a partial answer, i.e., solves three of the five examples.
Clear["Global`*"]
ClearAll[CircleDot]
Ket /: CircleDot[Bra[x__], Ket[y__]] :=
Times @@ MapThread[KroneckerDelta, {{x}, {y}}]
BraKet[x_, y_] := Bra[x]\[CircleDot]Ket[y]
CircleDot[e1_, HoldPattern[Plus[e2__]]] := Total@Map[CircleDot[e1, #] &, {e2}]
CircleDot[HoldPattern[Plus[e1__]], ...
2
I want to find different ways to get the actual value without using
the LinearSolve command
You can use Solve
ClearAll[x,i,j];
mat = Table[If[i == j, .5, If[i == j - 1 || i == j + 1, .25, 0]], {i, 1, 100}, {j, 1, 100}];
b = Table[1./i, {i, 1, 100}];
vars = Table[x[i], {i, Length@b}];
eqs = Thread[mat.vars == b];
Solve[eqs, vars]
Compare to
actual=...
4
Clear["Global`*"];
f[x_] = x E^-x - 1; (* Note `E` vice `e` *)
XY = {#, f[#]} & /@ Range[4]
(* {{1, -1 + 1/E}, {2, -1 + 2/E^2}, {3, -1 + 3/E^3}, {4, -1 + 4/E^4}} *)
p4[x_] = Fit[XY, {1, x, x^2, x^3, x^4}, x]
(* -0.589552 - 0.0147616 x - 0.0248196 x^2 - 0.00460293 x^3 + 0.00161548 x^4 *)
Plot[{p4[x], f[x]}, {x, 0, 4},
PlotStyle -> {Green, Red},
...
5
First, a basic mistake: in Mathematica, the natural log base is entered as E (or as Esc e Esc), and not plain e. And many folks prefer Exp[x] to E^x.
Also, your lines f[1];, f[2];, etc., since they end with semicolons, just suppress the output from them.
Second, even with that corrected, everything is fine until your final Show, where you have so ...
2
As with most *Q functions, CoprimeQ will evaluate to True or False immediately:
CoprimeQ[a,b,c]
False
You could instead use GCD:
FindInstance[
a + b == c && And @@ Thread[GCD @@@ Subsets[{a, b, c}, {2}] == 1],
{a, b, c},
Integers
]
{{a -> 1, b -> 0, c -> 1}}
although this approach won't work to find your example.
5
If you want to determine a symmetric matrix $A$ such that if $x=(1,x_1,x_2,x_3,x_4)$ and
$$x^T A x = 3 + x_1 - 2 x_4 + 2 x_3 x_4 + x_2 (-x_3 + x_4)$$
then the following (based on the comment by @yarchik) should do that:
(* Create a symbolic symmetric matrix *)
A = Table[a[Min[i, j], Max[i, j]], {i, 0, 4}, {j, 0, 4}];
(* Quadratic form *)
y = 3 + x1 - 2 ...
4
eqn = ψ[x] (k x^2/2 - En) - ℏ^2 ψ''[x]/(2 m) == 0;
sol = DSolve[eqn, ψ, x][[1]]
(* {ψ ->
Function[{x},
C[2] ParabolicCylinderD[(-2 En Sqrt[m] - Sqrt[k] ℏ)/(
2 Sqrt[k] ℏ), (I Sqrt[2] k^(1/4) m^(1/4) x)/Sqrt[ℏ]] +
C[1] ParabolicCylinderD[(2 En Sqrt[m] - Sqrt[k] ℏ)/(
2 Sqrt[k] ℏ), (Sqrt[2] k^(1/4) m^(1/4) x)/Sqrt[ℏ]]]} *)
Verifying ...
Top 50 recent answers are included
