15
There are infinitely many (continuum) solutions and basically one cannot list them all e.g. because of the Cantor theorem. This is the reason why numerical approach is unsatisfactory. However we can make use of FindRoot to find a finite numerical subset of the solution space.
Numerical solutions
First we set up a net of values of x and starting point of y ...
8
Try it:
## & @@ {1, 2, 3}
(* Sequence[1, 2, 3] *)
Sequence is a wrapper for a list that you want expanded into separate function arguments when it appears in an argument list.
I cannot say why the author didn't just do Sequence @@.
7
"Discovery" means that the vertex is seen, and registered for later processing.
"Visiting" means processing a vertex. This is a long process which includes processing its neighbours as well. Thus, there are two events: one is triggered when processing starts and one when processing finishes.
In depth-first search, processing a vertex means:
Fire Previsit ...
7
f1 = #^2 &;
f1' gives a pure function:
df1 = f1'
2 #1 &
df1[2]
4
Alternatively, you can use Derivative:
df1b = Derivative[1] @ f1
2 #1 &
df1b[3]
6
Re "to additionally manipulate the derivative inside the function", you can use Composition to wrap df1 with desired manipulations:
ndf1 = N@*(f1')
N@*(2 #1 &)
ndf1[2]
...
6
A few customizations for the IntervalSlider and InputField controls:
ClearAll[thumb, intSlider, inpField]
thumb = Graphics[{#, Text[Style["▲", #, 16], Offset[{0, -20}, {0, 0}]],
Text[Style[#2, 12], Offset[{0, -35}, {0, 0}]]}, ImageSize -> 20] &;
intSlider[Dynamic[{x_, y_}], range_, opts___ : OptionsPattern[]] :=
IntervalSlider[Dynamic[{x, y}]...
6
Make each element of replace a function by wrapping it with Function.
functions = Function /@ replace
{(αu #1)/(ku + #1) &, Du #1 &, (αv #1)/(kv + #1) &}
Use functions with Through to apply all functions to the same argument:
Through[functions@1]
{αu/(1 + ku), Du, αv/(1 + kv)}
Use Map to apply this function to a list of arguments:
...
5
Order of definition matters, oddly enough. If you switch the order of definitions, things will work OK. I always define the specific cases first, then the general.
ψ0[x_] := 1/(2 π)^(1/4) Exp[-(x^2/4) - I k x];
ψr[x_, 0] := ψ0[x];
ψr[x_?NumericQ, n_?NumericQ] := ψr[x, n] = NIntegrate[SK[y, x, Δt] (Projector[x]/
Sqrt[NIntegrate[Abs[Projector[x] ψr[x, n -...
5
FullForm[k_: Automatic]
(* Optional[Pattern[k,Blank[]],Automatic] *)
?Optional
p : v is a pattern object that represents an expression of the form p, which, if omitted, should be replaced by v
So, if you omit the argument, Automatic is what will be used.
5
Clear["Global`*"]
eqns = {t[n + 1] == 1/x t[n - 1] - 2/7 t[n], t[0] == 1, t[1] == x};
For comparison, use RSolve to obtain the general solution
sol = RSolve[eqns, t, n][[1]];
t[n] /. sol
(* (1/(2 Sqrt[
49 + x]))7^-n (-Sqrt[x] (-1 - Sqrt[49 + x]/Sqrt[x])^n -
7 x^(3/2) (-1 - Sqrt[49 + x]/Sqrt[x])^n +
Sqrt[49 + x] (-1 - Sqrt[49 + x]/Sqrt[x])^n +
...
5
I am curious what do you need this problem for? You can write a function for arbitrary numbers:
multSUM[n_,m_]:=Select[Table[m k,{k,n}],Divisible[Total[IntegerDigits[#]],m]&]
Then for exactly your problem, 100 first results:
Multicolumn[multSUM[10^4,17][[;;100]]]
4
You can find the exact solution directly:
RSolve[{t[n + 1] == t[n - 1]/x - 2/7 t[n], t[0] == 1, t[1] == x}, t[n], n] // FullSimplify
(* {{t[n] -> (7^-n (Sqrt[49 + x] (-1 - 1/Sqrt[x/(49 + x)])^n -
Sqrt[x] (1 + 7 x) (-1 - 1/Sqrt[x/(49 + x)])^n +
Sqrt[49 + x] (-1 + 1/Sqrt[x/(49 + x)])^n +
Sqrt[x] (1 + ...
4
Let's examine the problem as given. I will consider it as a general code rewriting problem. We have an expression of the form
h[.., f[ Evaluate[g[x]] ],..] (* or more generally... *)
h[.., f[ Evaluate[g[x]], y],..] (* etc. *)
where h is a HoldAll function and we'd like to evaluate g[x] but not f[] to get
h[.., f[g0],..] (* or *)
h[.., f[g0, y]...
4
ClearAll[x, y, z, f]
t = 4;
p = 5;
poly = (x + 2 y + z)^t + x^2;
f = Select[And[Total@# == t, Max[#] <= p - 2] &@Exponent[#, {x, y, z}] &];
selected = f @ MonomialList[poly]
{8 x^3 y, 4 x^3 z, 24 x^2 y^2, 24 x^2 y z, 6 x^2 z^2, 32 x y^3,
48 x y^2 z, 24 x y z^2, 4 x z^3, 32 y^3 z, 24 y^2 z^2, 8 y z^3}
Complement[MonomialList @ poly, ...
3
ptsech = {{0, 0}, {30., 0}, {54.366, 0.00901776}, {67.0222,
0.477768}, {70.7722, 4.22777}, {71.241, 16.884}, {71.25, 41.25}, {71.25,
71.25}, {71.259, 95.616}, {71.7278, 108.272}, {75.4778, 112.022}, {88.134,
112.491}, {112.5, 112.5}, {142.5, 112.5}, {166.866, 112.509}, {179.522,
112.978}, {183.272, 116.728}, {183.741, 129.384}, {183.75,
...
3
Update: Used the built-in "InterpolationPointSubdivision" method.
Update 2: Memoization helps because the subdivision is at the same points (given by xcoords in the code below) every time. So in intNest2[], the call int1st2[xp, t] will initially be made at the same xp for each subinterval, unless the subinterval contains the singular point x. I say, "...
3
Use {n} as the level spec to apply the function only to elements at level n. If you use n as the level spec, the function is applied to elements at levels 1 thru n.
lst = {{{a, b}, {b, c}}, {{c, d}}}
Map[f, lst, {3}]
{{{f[a], f[b]}, {f[b], f[c]}}, {{f[c], f[d]}}}
Map >> Details and Options:
3
y=f(-x) to reflect about y-axis
It would be better to make your f a function, something like
f[x_] := Sin[(((2*0 + 1)* Pi *(-x))/(2*2))];
Plot[{f[x], f[-x]}, {x, -2, 2}]
ps. why do you have 2*0 in there?
To answer comment:
ClearAll[f, x];
f[x_] := Table[Sin[(((2*i + 1)*Pi*(-x))/(2*2))], {i, 0, 2}];
p1 = Plot[Evaluate@f[x], {x, -2, 2}, PlotLabel -> "...
3
One way is to use Minimize and Maximize with constraint.
Need to make sure min is smaller than max, else you'll get unexpected results.
Manipulate[
Module[{a, b},
Quiet@Grid[{
{"expression", "Min", "Max"},
{"a+b",
First@Minimize[{a + b, minA < a < maxA && minB < b < maxB}, {a, b}],
First@Maximize[{a + b, minA ...
3
This works (at least to the limited extent that I have tested it) ...
17 Flatten[Position[Total/@IntegerDigits/@(17 Range[10000]),17]]
To understand it, pick it apart from the inside out, ie first figure out
Range[10000]
(start with a number of multiples smaller than 10k) then
17 Range[10000]
then
IntegerDigits/@(17 Range[10000])
and so for the
3
Reap and Sow can be used. For example,
r = Reap[Table[
Sow[17 j, IntegerDigits[17 j] // Total], {j, 1, 10000}], 17][[2,
1]];
This yields 452 integers. Showing first 100:
Partition[r[[1 ;; 100]], 10] // Grid
3
Clear[f, i, x]
f[x_] := x^2 - 7*x + 6;
For comparison, the roots are
Solve[f[x] == 0, x]
(* {{x -> 1}, {x -> 6}} *)
Rather than using For, use NestList for a fixed number of iterations
NestList[# - f[#]/f'[#] &, 3., 20]
(* {3., -3., -0.230769, 0.796987, 0.992376, 0.999988, 1., 1., 1., 1., 1., 1., \
1., 1., 1., 1., 1., 1., 1., 1., 1.} *)
...
3
Reduce also seems to work on the original f, though the answer it gives is somewhat long and involves a collection of Tan and ArcTan.
f[x_, y_] := (4 y^2 - 6) (Cos[y \[Pi]] Cos[x] - Cos[2 y \[Pi]] Sin[x]);
Reduce[f[x, y] == 0, {x, y}]
2
Using marks from MikeY's answer:
assoc = KeySort @ GroupBy[PadRight[marks][[All, {2, 3, 1, 4}]],
#[[;;2]] &, #[[All, 3 ;;]] &]
<|{"Barak", "Obama"} -> {{1, 22}},
{"Boris", "Johnson"} -> {{1, 0}, {2, 0}, {3, 0}},
{"David", "Cameron"} -> {{1, 18}, {3, 11}, {4, 17}},
{"Donald", "Trump"} -> {{2, 8}}|>
KeyValueMap[{## & @@ #, #2} &...
2
RSolve might be the best worker for this job and also do not forget RecurrenceTable.
But here I offer a solution via the method of transfer matrix. Denoting $ v_n = (T_{n-1}\quad T_n)^\top $ so that $ v_1 = (1\quad x)^\top $, and the transfer matrix $ M $,
$$
M =
\begin{pmatrix}
0 & 1 \\
1/x & -2/7
\end{pmatrix},
$$
the recursive relation can be ...
2
Try
f1 = #^2 &;
derivative
f1s = Function[x, f1'[x] // Evaluate]
f1s[u] (*2 u*)
or
F1s[u_] := f1'[u]
2
This behavior is due in this specific case to NHoldAll. Under Scope we find both Derivative and Slot, among many others which also have this attribute.
2
Unfortunately, no explanantion of the function PhysicalQ is given. What does it mean?
If you had browsed the Wolfram Functions site more thoroughly, you would have found the "Primary Definition" page for ThreeJSymbol[], and then you would have seen the required definitions for PhysicalQ[] and the associated function TriangularQ[] (which yarchik has astutely ...
2
Using your original definitions:
fn = Function @@ {replace};
fn[2]
{(2 αu)/(2 + ku), 2 Du, (2 αv)/(2 + kv)}
fn /@ {1, 2}
{{αu/(1 + ku), Du, αv/(1 + kv)}, {(2 αu)/(2 + ku), 2 Du, (2 αv)/(2 + kv)}}
fn @ {1, 2}
{{αu/(1 + ku), (2 αu)/(2 + ku)}, {Du, 2 Du}, {αv/(1 + kv), (2 αv)/(2 + kv)}}
2
You can enter 5 10^6 as 5*^6 and save two characters, although I don't think that's really worthwhile or improves readability.
Limit can be entered as Esc lim Escwith the limit in an underscript. Not sure whether you would consider that a shortcut.
2
Brute-force search will be much better here than FindInstance.
In[16]:= First@Last@Reap@Do[
If[Total@IntegerDigits[x^y] == x, Sow[{x, y}]],
{x, 2, 20}, {y, 2, 10}
]
Out[16]= {{7, 4}, {8, 3}, {9, 2}, {17, 3}, {18, 3}, {18, 6}, {18, 7}}
Only top voted, non community-wiki answers of a minimum length are eligible
