New answers tagged function-construction
4
Approach 1, more concise
Clear[search];
search[n_] :=
Join @@ Table[With[{s = Subsets[a, {2}]},
Pick[s, Boole@MemberQ[a, Total@#] & /@ s, 1]],
{a, GatherBy[Select[Range[10^(n - 1), 10^n - 1], Divisible[#, 9] &],
Sort@*IntegerDigits]}];
search[4] // Length // AbsoluteTiming
search[5] // Length // AbsoluteTiming
search[6] // ...
4
The MeshFunctions
is a powerful method which I always use.
Here we view the Mesh from 3D. So we draw the ParametricPlot3D
$$\begin{cases}x=\sqrt{r^2+0.9801} \sin (\theta ),\\
y=r \cos (\theta ),\\
z=f(r,\theta)\end{cases}$$
We set the ViewPoint={0,0,Infinity} and use ViewProjection -> "Orthographic"
Clear["`*"];
Σ[r_, a_, θ_] = r^2 + ...
1
@Natas, the thing is with this question that equipotentials are not plotted in polar coordinates, they are plotted in some special coordinates similar to polar coordinates (take a look at the first argument in ParametricPlot, "ParametricPlot[{Sqrt[r^2 + 0.99^2]*Sin[[Theta]], r Cos[[Theta]]},..."). That is why ParametricPlot way was used instead of ...
0
Divide the numbers from 1000 to 9999 into a few hundred sets of integers that have the same digits, for example [1234, 1243, 1324, 1342, 1423, 1432 ... ]. Then a and b must be in the same set, and a+b must be in that set as well. So you loop over the 400 or so sets S of integers, then iterate over all elements a < 5000 of the set S, iterate b over all ...
4
Regarding your question as to why trajectories has four arguments:
MeshFunctions for ParametricPlot need three to four arguments. The first two correspond to the coordinates of the plot, the last two (or one) to the parameters of the ParametricPlot.
To appreciate this better, consider the following example:
funs = {
Function[{x, y, u, v}, x],
Function[{...
0
Tis needs an explanation. Consider:
fred := a*b;
bob[a_, b_] := fred;
joe[a_] :=
Sum[Print[{"a=", a, "b=", b, "bob=", HoldForm[bob[a, b]], bob[a, b],
"fred=", fred}]; bob[a, b], {b, Range[3]}];
joe[2]
{a=,2,b=,1,bob=,bob[2,b],a,fred=,a}
{a=,2,b=,2,bob=,bob[2,b],2 a,fred=,2 a}
{a=,2,b=,3,bob=,bob[2,b],3 a,fred=...
7
Try the following
Series[f[InverseFunction[g][y]],{y,0,10}]
2
Do integration first and then take the limit k-> inf.
Use indefinite integration. Integrate only finds a solution for m==0.
g[x_, m_, k_] = 1/((2*(x - m))^(2*k) + 1)
mint[x_, k_] = Integrate[g[x, 0, k], x]
(* x Hypergeometric2F1[1, 1/(2 k), 1 + 1/(2 k), -4^k x^(2 k)] *)
Use a trick. Tell Limit that x^(2 k) is always positive. (Valid for Integer k)...
2
Does this help?
f2[x_?NumericQ, m_] := Limit[1/((2*(x - m))^(2*k) + 1), k -> Infinity];
Module[{m = 0}, NIntegrate[f2[x, m], {x, m - 1/2, m + 1/2}]]
(* 1. *)
0
Maybe out of slope...
Since this range is kind of huge. So use Python's Api maybe a better choice?
ExternalEvaluate["Python", "[(i, j, i+j)for i in range(1000, 9999) for j in range(i, 9999-i)
if sorted(str(i)) == sorted(str(j)) == sorted(str(i+j))]"] // AbsoluteTiming
{27.2873, {{1089, 8019, 9108}, {1089, 8091, 9180}, {1269, 1692,
...
12
ClearAll[pairS]
pairS[n_] := SortBy[First] @
Apply[Join] @
KeyValueMap[Function[{k, v},
Select[k == Sort@IntegerDigits@Total@# &]@Subsets[v, {2}]]] @
GroupBy[Sort@*IntegerDigits] @
(999 + 9 Range[10^(n - 1)])
Examples:
pairS[4] // AbsoluteTiming // First
0.0445052
pairS[5] // AbsoluteTiming // First
1.19877
Multicolumn[pairS[4],...
2
But it took ages to give the output.
It took ~170 seconds on my computer; with ParallelTable it took ~97 seconds.
I assume two-times speed-up is not good enough, but it was very easy to get it.
1
The question is similar to how to construct a series of pure functions.
Function /@ Table[(Slot[1] + Slot[2]) v, {v, {Slot[1], Slot[2]}}]
Some codes similar with @BobHanlon in the comment is
Outer[Function[{x, y}, (x + y) #] &, {x, y}]
2
Integrate[
E^(-\[Alpha] \[Sqrt](x^2 +
y^2)), {x, -\[Infinity], \[Infinity]}, {y, -\[Infinity], \
\[Infinity]}, Assumptions -> a > 0]
(ConditionalExpression[(2 \[Pi])/\[Alpha]^2, Re[\[Alpha]] > 0])
There is an internal parameter to the notebooks called $Assumption.
There is the documentation page for Assumptions for the built-ins Simplify, ...
1
Try this
Lagata2[Data_]:=Module[{XX=Data},
ELI[XX_,i_]:=(X=Drop[XX,{i}];
Product[(x-X[[j,1]])/(XX[[i,1]]-X[[j,1]]), {j,1,Length[X]}]);
Sum[XX[[i,2]]*ELI[XX,i],{i,1,Length[XX]}]
]
To test it and compare with function.
BTW, I use Labatto intervals
f[x_] = 1/(1+10x^4);
...
1
Here is the idea for using convolution. I suspect there is similar in the reference page for ListConvolve. I first illustrate in a slightly roundabout way, by creating explicit polynomials and then extracting coefficient lists.
SeedRandom[1234]
s = 10;
n = 8;
p1 = randomPoly[n, s, x]
p2 = randomPoly[n, s, x]
c1 = CoefficientList[p1, x]
c2 = CoefficientList[...
4
To make it simple, I choose a set of symbols (you can replace them with points in 1,2,3.. n dimensions):
sym = Array[Subscript[s, #] &, 4]
We get all automorphism by Permutations[sym]. A permutation gives the image of the first element, the second element ...
automorph= Permutations[sym]
Finally to pick all automorphism that fulfill some predicate &...
1
If you have a fixed maximum degree of polynomials, you can compute the product of two generic polynomials. This is in some sense similar to a naive implementation of symbolic automatic differentiation.
ClearAll[make$mult] ;
make$mult[] := Block[
{x, a, b, c1, c2, p1, p2, p3, arg, list},
p1 = a0 + Dot[c1 = ToExpression[Map[StringTemplate["a``&...
1
I thought that Plot ignored values that are not numbers and also suppressed errors. When I try the following:
f[x_?(2 <= # <= 4 &)] := 1/0;
f[x_?(4 < # <= 6 &)] := Indeterminate;
f[x_] := x^2;
and then
Plot[f[x],{x,0,10}]
I don't get any errors and the plot ignores x values from 2 to 6.
5
There are two issues here:
Defining the function
You could use a Condition to prevent the function from evaluating at the forbidden points:
forbiddenValues = {1, E, Pi};
forbiddenQ[x_] := Or @@ Table[x == value, {value, forbiddenValues}] // Evaluate;
f[x_] /; !forbiddenQ[x] := x^2
f /@ {1, 2, E, 4, Pi}
(* {f[1], 4, f[E], 16, f[Pi]} *)
Plotting
From @Natas'...
2
This maybe easier to understand?
Table[Boole[OddQ@i && OddQ@j && i == j], {i, 0, 5}, {j, 0, 5}]
5
Mod[DiagonalMatrix[Range[#] - 1], 2] & @ 7
Boole @ Array[EvenQ@# && # == #2 &, {#, #}] & @ 7
SparseArray[Band[{2, 2}, {#, #}, {2, 2}] -> 1] & @ 7
SparseArray[{i_, i_} :> Mod[i + 1, 2], {#, #}] & @ 7
MapAt[0 # &, IdentityMatrix@#, {;; , ;; ;; 2}] & @ 7
MapIndexed[Mod[#2[[1]] + 1, 2] # &]@ IdentityMatrix[#] &...
6
Another solution:
diagonalMatrix[n_] := DiagonalMatrix@PadRight[{}, n, {0, 1}]
5
n = 9;
ReplacePart[ConstantArray[0, {n, n}], {i_?EvenQ, i_?EvenQ} -> 1]
% // MatrixForm
Or
Clear["`*"];
n = 9;
M = SparseArray[{{i_, i_} /; Mod[i, 2] == 0 -> 1}, {n, n}];
M // Normal // MatrixForm
2
I have rewritten your code somewhat. It now completes in python and it works in Mathematica. Please tell me if the outputs are reasonable.
solution3d[edges_, vd_, vl_, ew_] := Module[{
uedges = UndirectedEdge @@@ edges,
vcoords = List @@ vd,
ew2 = KeyMap[UndirectedEdge @@ # &, ew],
vars3d, \[Lambda], lbnd, ubnd, obj3d, err, sol, edgeLengths3d}...
0
This problem is an example of finding rules that match number sequences. For problems like these, the answer is less important than understanding the steps you use to find a solution.
A number sequence is a list of numbers that's defined by a rule. If you work out the rule, you can find the numbers in the sequence. Find the rule by looking for a pattern or ...
0
Let me first explain that it makes sense to use Table only when you know the functional form of a sequence. In you example one can only guess what was the actual idea for this homework. One possible solution would be
Table[j + i^2 - 1, {j, {2, 9, 28}}, {i, 3}]
But I would like to emphasize that both, for this forum and for your teacher, you need to ...
1
It seems there is no solution like c language. A workaround is based on list.
bigNastyFunction =Compile[{{y, _Complex}}, Sin[y](*,CompilationTarget\[Rule]C*)]
f = Compile[{{x, _Complex}},
Block[{xl = {x, x^2, x^3}, coefList = {1, 1, 3},fx}, fx =
Table[bigNastyFunction[ii], {ii, xl}];fx[[2]] = fx[[2]]^2;
fx.coefList], CompilationOptions -...
2
Here is one way to find the information you are seeking. Bring up the Document Center (Mathematica help) window. Type "define a function" in the search field and click on the maginifing glass icon on its right. You will see
or something similar depending on what OS you are running.
Click on the 2nd hit "Defining variables and functions". ...
1
You’ll want to check out https://reference.wolfram.com/language/tutorial/FunctionsAndPrograms.html
In the notation you gave, you might write
solution3d[a_, b_, c_, d_] := doSomeStuff
If you want to do multiple things, you might write
solution3d[a_, b_, c_, d_] := (x = a + b; y = c + d; {x , y})
The semi-colons are used to create compound expressions. The ...
1
Clear["Global`*"]
TT[x_, g_] := x^2/(x^2 + g^2)
fte[x_, m_, t_] := 1/(Exp[(x - m)/t] + 1)
V = 100;
g = 3;
lim1 = 20;
fun[x_, tem_] =
D[TT[x, g]*fte[x, +V/2, tem]*(1 - fte[x, +V/2, tem]), x] // FullSimplify
(*TT is a transmission function and fte is the Fermi distribution*)
(* -((x Sech[(-50 + x)/(
2 tem)]^2 (-18 tem + x (9 + x^2) Tanh[(-...
3
ClearAll[indexArgs]
indexArgs = Module[{counts = Counts[List @@ #], assoc},
assoc = 1 & /@ counts;
Replace[ #, x_Symbol /; counts[x] > 1 :>
Symbol[SymbolName[x] <> ToString[assoc[x]++]], All, Heads -> False]] &;
Examples:
Grid[{#, indexArgs @ #} & /@ {h[o, i, o, s, d], h[o, i, s, o, d],
h[o, i, s, d, o], h[i,...
5
This works for me:
modArgs[res : h_[args__]] := Module[{pos, sym, tl},
tl = Tally[{args}];
pos = Table[Position[{args}, id, 1], {id, tl[[All, 1]]}];
sym = Function[{n, c}, If[c > 1,
Array[Symbol[ToString[n] <> IntegerString[#1]] &, c],
{n}]] @@@ tl;
ReplacePart[res, Flatten[...
answered Sep 22 at 14:47
2
I can recommend more practical for numerical calculations next definition:
SetAttributes[SimpsonIntegral, HoldAll]
SimpsonIntegral[f_, x_, xmin_, xmax_,
steps_] := (xmax - xmin)/(3 steps) (Sum[
f /. {x -> xmin + (xmax - xmin)/steps (2*y - 2)}, {y, 1,
steps/2}] +
4*Sum[f /. {x -> xmin + (xmax - xmin)/steps (2*y - 1)}, {y, 1,
...
3
Clear["Global`*"]
The integral needs to be done one way or another. You can use Normalize directly
f[x_] = Normalize[A Sinc[x], Integrate[#, {x, -Infinity, Infinity}] &]
(* Sinc[x]/π *)
Verifying,
Integrate[f[x], {x, -Infinity, Infinity}]
(* 1 *)
Top 50 recent answers are included
