Tag Info

Hot answers tagged

8

I'll mimic the precision/accuracy handling for FindRoot as indicated in its documentation: The default settings for AccuracyGoal and PrecisionGoal are WorkingPrecision/2. The setting for AccuracyGoal specifies the number of digits of accuracy to seek in both the value of the position of the root, and the value of the function at the root. The ...


7

As suggested in the comments by both me and Jens r = Defer[Integrate][Cos[x], x]; r /. Defer -> Identity Sin[x]


6

I have given your code only a cursory read but I think I spotted a (the?) problem: your Message code uses an unheld equivalent of the test expression itself. This cannot work. If the expression would generate a Message the first time it would even within Message and you will get infinite recursion. Use HoldForm to prevent this: (*check the type of the ...


5

Using method that Guess who it is suggested I managed to get around 75% faster result. Unsample[x_] :=Riffle[temp = Riffle[x, x] // Transpose; temp, temp]//Transpose ans = Table[Map[Unsample[#] &, arr[[i]]], {i, 5000}]; // AbsoluteTiming Your suggested solution evaluates in 1 to 1.2 sec on my machine, while this one evaluates in 0.63 s. I suspect ...


5

OK, now let me have a trial:D. In this answer I will implement the Bernstein fully. We know the Bernstein basis function owns the :following defintion: $B_{n,i}(u)=\binom n i u^i(1-u)^{n-i}$, where $0 \leq u \leq 1$ In addition, the first derivative of $B_{n,i}(u)$ has the below relationship: $B'_{n,i}(u)=n\left[B_{n-1,i-1}(u)-B_{n-1,i}(u)\right]$ Main ...


5

Defer is a special head that behaves like Hold, but it has an additional rule for output: it disappears from the output box expression. There is nothing special about how it is handled as input -- all the "magic" takes place during output formatting. To emulate this process, simply apply a ToBoxes ToExpression pair: r = Defer[Integrate][Cos[x], x]; r // ...


5

Following belisarius's interpretation of your question, and if the total number of terms is not too large, I might write: Total /@ (1.0/GroupBy[Array[Sqrt, 2003], IntegerQ]) <|True -> 4.37273, False -> 83.6879|> Another formulation: fn[x_Integer] := {1.0/x, 0}; fn[x_] := {0, 1.0/x} Sum[fn @ Sqrt[k], {k, 1, 2003}] {4.37273, 83.6879} ...


4

I haven't followed your logic carefully, but you probably want something like Fcoord[coord : {_?NumericQ, _String}] := Module[{x, y}, If[(Mod[coord[[1]], 30]) != 0, y = (Quotient[coord[[1]], 30] + 1)*100; x = Mod[coord[[1]], 30]*100, y = (Quotient[coord[[1]], 30])*100; x = 3000.]; Switch[coord[[2]], "I", { x, y}, "II", {-x, y}, ...


4

I am going to demonstrate this with a smaller matrix to enable us to more readily view the results. A0 = Table[Subscript[a, i, j], {i, 8}, {j, 8}]; A0//MatrixForm Step 1. Partition A0 into 4x4 blocks A0byBlock = Partition[A0, {4, 4}]; A0byBlock // MatrixForm Step 2. Map f onto A0 at level 2 A0out = Map[f, A0byBlock, {2}]; A0out // MatrixForm ...


4

Click on your figure. Then a set of graphics tools will appear beneath your figure. Use the Coordinates Tool. One by one, click on the corners of the region you seek. Then use the window below to Copy Coordinates. Here the ones I get for the front W face of your figure: {{72.5`, 507.5`}, {70.5`, 158.5`}, {135.5`, 140.5`}, {136.5`, 484.5`}, {209.5`, ...


4

Why do I get an empty plot? Often new Mathematica users (and some not-so-new users) post questions asking why their plot of some expression just shows axes, with no plotted curve appearing. The key thing to keep in mind is that this will almost never have to do with the Plot command itself. It invariably occurs because the expression is not evaluating to a ...


4

Today, I implement the Bernsteinbasis function by myself like the built-in BernsteinBasis with the help of the following formula: $$B_{n,i}(u)=\binom n i u^i(1-u)^{n-i}$$ Here we define $B_{n,i}(u)=0$ when $i<0 $ or $i>n$ $$B'_{n,i}(u)=n\left[B_{n-1,i-1}(u)-B_{n-1,i}(u)\right]$$ Implementation (*usage*) ​Bernstein::usage = "​Bernstein[d,n,x] ...


3

I think $PreRead may be your only hope (but see below). You can set it up with $PreRead = (# /. RowBox@{"PermanentRespect", "[", expr_, "]"} | RowBox@{"PermanentRespect", "@", expr_} | RowBox@{expr_, "//", "PermanentRespect"} :> RowBox@{"RawBoxes", "[", MakeBoxes@expr, "]"} ) &; LoseRespect[expr_] := expr /. RawBoxes -> ToExpression ...


3

My comment in Manipulate form: func = {x^2 + x y + y^2}; Manipulate[ D[func, variable], {variable, {x, y}} ] The control that Manipulate uses is the SetterBar[Dynamic[variable], {x, y}] of my comment.


3

Your problem is the Set. Set means you're assigning something to a variable (=), x2 Sin[x2] is not a variable. Try Equal[] instead, this is equivalent to ==. Vars = {{(x1) Cos[x2], Sin[x2], 0, (x3) (Sin[x2])}, {(Cos[x2]) (Sin[x4]), (x3) Cos[x4], 1, x1}}; Const = {{1, 0, 0, 1}, {0, 1, 1, 2}}; MapThread[Equal, {Vars, Const}, 2] yields the output: {{x1 ...


3

It seems to me that merely defining a global default value enables the kind of application for associations that you are discussing. asc = <||>; $asc = 0; (KeyExistsQ[#][asc] || (asc[#] = $asc); ++asc[#]) & /@ {"a", "a", "b", "a", "b", "a"} {1, 2, 1, 3, 2, 4} asc <|"a" -> 4, "b" -> 2|> bsc = <||>; $bsc = 1; ...


2

If my interpretation of your question is correct, the following code should produce the desired behaviour. prePrint[input_] := Module[{solveFor}, input /. {D[y_, x_, NonConstants -> {y_}] :> (solveFor = y'[x])} // If[OwnValues[solveFor] === {}, input, Solve[#, solveFor]] & // FullSimplify]; $PrePrint = prePrint; Test D[x == ...


2

Sum[If[IntegerQ[#], {1, 0}, {0, 1}]*1/# &@Sqrt[k], {k, 1, 2003}] // N or Sum[If[# ∈ Rationals, {1, 0}, {0, 1}]*# &[1/Sqrt[k]], {k, 1, 2003}] // N both return {4.37273, 83.6879}


2

To be honest, I was quite surprised that Mathematica finds an analytical solution when you just enter the problem in naively: Area[RegionIntersection[Disk[{l, 0}, l], Disk[{0, l}, l], Disk[{l/2, l/2}, l/2]]] On Mathematica 10.1 I don't get the expression with complex terms that Fernando got above, I get the purely real ConditionalExpression[-(1/4) ...


2

You could use Function[{args1, var2, var3}, With[{deg = args1[[1]], knots = args1[[2]]}, code ]] Not the neatest, but it would seem to do the job.


2

I did compile the addtwo example using CreateExecutable as follows: examplesDir = FileNameJoin[{$InstallationDirectory, "SystemFiles", "Links", "WSTP", "DeveloperKit", $SystemID, "WSTPExamples", "addtwo"}]; files = FileNames["*", examplesDir] compilerAdditionsDir = FileNameJoin[{$InstallationDirectory, "SystemFiles", "Links", "WSTP", ...


2

I tried many methods last day, lastly, I found that the following solution can deal with this problem(I didn't know why) a = Derivative[{0, {(0) ..}}, 0, k_Integer?Positive][NBSpline] // FullForm; b = Derivative[{0, {0 ..}}, 0, k_Integer?Positive][NBSpline] // FullForm; a === b True Namely,replace NBSpline /: Derivative[{0, {0 ..}}, 0, ...


1

The Table approach: data = {{66, 55, 3}, {44, 33, 2}, {22, 11, 1}}; Grid[{{Style["direction North", Bold]}}~Join~ Table[{Style["traffic path", Bold], i, Labeled[InputField[Dynamic[data[[#, 1]]] &@i, FieldSize -> 10], "Q", Left, LabelStyle -> Directive[Bold]], Labeled[InputField[Dynamic[data[[#, 2]]] ...


1

Try this: data = {{66, 55, 3}, {44, 33, 2}, {22, 11, 1}}; MapIndexed[(d[First[#2]] = #[[1]]) &, data]; MapIndexed[(e[First[#2]] = #[[2]]) &, data]; MapIndexed[(f[First[#2]] = #[[3]]) &, data]; Grid[Prepend[Map[Function[i, {Style["traffic path", Bold], i, Labeled[InputField[Dynamic[d[i], (d[i] = data[[i, 1]] = #) &], ...


1

Here is an attempt. It most probably won't do for large matrices due to the inefficient algorithm, but it seems to work on smaller examples: enlargeBlock[matrix_List, blockStart_List, blockEnd_List] := Which[ (* enlarge in the down-right-diagonal direction, if possible *) And @@ Thread[blockEnd < Dimensions@matrix] && ...


1

Frankly, I'd write this function differently, at least if B is small: ClearAll[pollard]; Module[{p}, p[n_, i_] := GCD[PowerMod[2, i!, n] - 1, n]; pollard[n_, B_] := p[n, #] & /@ Select[Range[2, B], 1 < p[n, #] < n &, 1]] I am not entirely sure what your function is intended to return, and how you define "most B iterations" (since your ...


1

This should produce the desired dialog loop pdGUIstyled[func_, outputList_: {}] := Setting@DynamicModule[{variable}, Module[{symboles = Cases[func, _Symbol, Infinity] // DeleteDuplicates, lastRes}, lastRes = DialogInput[ Column[{ Row[{"the function is: ", Panel[func, Background -> White]}], "", Row[{"the current list of ...



Only top voted, non community-wiki answers of a minimum length are eligible