Community RSS Feed
http://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Mathematics sorted by activeWhy does Mathematica show version 11.0.0 after updating to 11.0.1?
http://community.wolfram.com/groups/-/m/t/1070296
I originally installed Mathematica 11.0.0, but I downloaded Mathematica 11.0.1 and successfully ran the installation script. Why does Mathematica stll show version 11.0.0? Do I have two versions installed, and if so, how to I delete the old version and start the updated version?Steven Clark2017-04-24T02:52:44Z[CALL] Common mistakes in using Wolfram Language & Mathematica
http://community.wolfram.com/groups/-/m/t/1070264
[Wolfram Language][1] (WL) is a powerful multi-paradigm programing language. There is a set of common mistakes that repeatedly tend to entrap new users. **This is a call to describe such mistakes building a "black-listing" guide for novice coders.** Please consider contributing. I suggest following simple rules (with gratitude adapted from a [similar effort][2]):
- One topic per answer
- Focus on non-advanced uses (it is intended to be useful for beginners and as a question closing reference)
- Include a self explanatory title in header style (example: "# Basic built-in function syntax"; see [syntax guide][3] )
- Explain the symptoms, the mechanism behind the scenes and all possible causes and solutions you can think of. Be sure to include a beginner's level explanation (and a more advance one too, if you can)
*Please, use "**Reply**" to a specific comment for structured clarity of nested comments.*
----------
## Table of Contents
- [Basic syntax of built-in functions][4]
- [Learn how to use the Documentation Center effectively][5]
[1]: https://www.wolfram.com/language
[2]: https://mathematica.stackexchange.com/q/18393/13
[3]: http://community.wolfram.com/groups/-/m/t/270507
[4]: http://community.wolfram.com/groups/-/m/t/1069885
[5]: http://community.wolfram.com/groups/-/m/t/1070285Vitaliy Kaurov2017-04-23T23:54:23ZWhy does kernel crash when calculating sum of HypergeometricPFQ functions?
http://community.wolfram.com/groups/-/m/t/1070255
Why does the kernel crash and exit when I try to run the last three evaluations in the attached notebook?
Does anyone have any suggestions as to how I can get around this obstacle?
I'm running Mathematica 11 Home Edition on Ubuntu 16.04 LTS on an Intel i5 processor:
Version Number: 11.0.0.0
Platform: Linux x86 (64-bit)
Here's an extract of the definition of the function.
fSum[y_, imax_] := Block[{i = 1, isum = 0},
While[i <= imax,
isum += (HypergeometricPFQ[{3/4 + 1/2 I Im[ZetaZero[i]]}, {1,
7/4 + 1/2 I Im[ZetaZero[i]]}, -(y^2/4)]/(-3 I +
2 Im[ZetaZero[i]]) -
HypergeometricPFQ[{3/4 - 1/2 I Im[ZetaZero[i]]}, {1,
7/4 - 1/2 I Im[ZetaZero[i]]}, -(y^2/4)]/(
3 I + 2 Im[ZetaZero[i]])); i++];
2 I isum]
Here's an extract of the evaluation which causes the problem. I can run an evaluation with imax=45, but not with imax=46.
Plot[N[fSum[y, 46]], {y, 0, 50}, GridLines -> Automatic,
PlotPoints -> 200, MaxRecursion -> 0]Steven Clark2017-04-23T23:34:02ZThe Chaos Game - Sierpinski triangles and beyond - part I
http://community.wolfram.com/groups/-/m/t/1025180
EDIT: See also the follow up posts [here.][1] and [here][2].
![enter image description here][3]
Roughly 8-9 years ago a friend of mine told me I could make the Sierpinski triangle by starting at one of the vertices of an equilateral triangle, and then repeatedly jump half-way to one of the (randomly chosen) vertices.
## 0 memory ##
The following code will accomplish that:
ClearAll[sequence]
sequence[n_,m_]:=RandomChoice[Range[n],m]
pts=N@CirclePoints[3];
pts=FoldList[(#1+pts[[#2]])/2&,RandomChoice[pts],sequence[3,10]]
Graphics[{{FaceForm[],EdgeForm[Black],RegularPolygon[3]},Red,Arrow[Partition[pts,2,1]]}]
giving:
![enter image description here][4]
If one does this 1000s of time, and only mark the viewed points, one will get:
ClearAll[sequence]
sequence[n_,m_]:=RandomChoice[Range[n],m]
pts=N@CirclePoints[3];
pts=FoldList[(#1+pts[[#2]])/2&,RandomChoice[pts],sequence[3,25000]];
Graphics[{FaceForm[],EdgeForm[Black],RegularPolygon[3],PointSize[0.001],Point[pts]}]
giving:
![enter image description here][5]
Which will indeed show that by randomly choosing a vertex we can still get structure! Quite a surprise! Of course we can do this with squares, pentagons, hexagons et cetera:
ClearAll[sequence]
sequence[n_,m_]:=RandomChoice[Range[n],m]
Table[
circlepoints=N@CirclePoints[n];
pts=FoldList[(#1+circlepoints[[#2]])/2&,RandomChoice[circlepoints],sequence[n,50000]];
Rasterize[Graphics[{FaceForm[],EdgeForm[Black],RegularPolygon[n],PointSize[0.001],Point[pts]},ImageSize->500,PlotRange->1.1],"Image"]
,
{n,3,8}
] // Partition[#, 3] & // ImageAssemble
giving:
![enter image description here][6]
Very neat! (apart from 4, which just gives a homogeneous distribution of points). Here I run the pentagon many many points and high resolution to get:
![enter image description here][7]
Where now the gray-color represents the density of points.
## 0 memory - restricted ##
Now we can make the dynamics a bit more interesting by not moving to any other vertex but to only specific vertices. Imagine that we are at some position p, then we always have n choices (n being the number of sides): we can jump to the vertex 1 ahead, 2 ahead, .... n ahead (same as last time).
ClearAll[CreateSequence,CreateSequenceImage]
CreateSequence[n_,steps_,choices_]:=Mod[Accumulate[RandomChoice[choices,steps-1]~Prepend~1],n,1]
CreateSequenceImage[n_,m_,choices_]:=Module[{seq,pts},
seq=CreateSequence[n,m,choices];
pts=N@CirclePoints[n];
seq=FoldList[(#1+pts[[#2]])/2&,First[pts],seq];
Rasterize[Graphics[{PointSize[0.001],Point[seq]},ImageSize->500,PlotRange->1],"Image",RasterSize->{300,300}]
]
For a 3 sided polygon (i've been told these are called triangles) we can jump 1, 2, or 3 ahead or subsets of that:
Grid[Join@@@Partition[{#,CreateSequenceImage[3,10^5,#]}&/@Subsets[Range[3],{1,\[Infinity]}],UpTo[3]],Frame->All]
![enter image description here][8]
Some interesting structure can be seen for some of the subsets.
For squares:
Grid[Join@@@Partition[{#,CreateSequenceImage[4,10^5,#]}&/@Subsets[Range[4],{1,\[Infinity]}],UpTo[4]],Frame->All]
![enter image description here][9]
and for pentagons:
Grid[Join@@@Partition[{#,CreateSequenceImage[5,10^5,#]}&/@Subsets[Range[5],{1,\[Infinity]}],UpTo[4]],Frame->All]
![enter image description here][10]
the higher the number of sides, the more subsets we can choose. The number of subsets scales as 2^n -1 (minus one because the set can not be empty; we have to jump somewhere!).
Lastly, for hexagons:
Grid[Join@@@Partition[{#,CreateSequenceImage[5,10^5,#]}&/@Subsets[Range[5],{1,\[Infinity]}],UpTo[4]],Frame->All]
![enter image description here][11]
Ok, you can try polygons with large number of sides on your own, but note that the number of subsets doubles every time.
## 1 memory - restricted ##
We can even go beyond this, and consider the position of the penultimate vertex as well:
![enter image description here][12]
We can consider 5 cases for a pentagon (or, in general, n cases). We will consider the last point to be at position 0 (or n), now the penultimate vertex could be in 5 different positions. For each of these combinations we can choose a different subset of {1,2,3,4,5}. Just to get an idea how many possibilities we now have:
the number of subsets is 2^n - 1, and we have to choose n of these, so there will be (2^n-1)^n different systems to explore:
Table[{n, (2^n - 1)^n}, {n, 3, 8}] // Grid
![enter image description here][13]
as one can see, the combination grow very quickly.
ClearAll[Stamp,CreateSequence2,CreateSequenceImage2]
CreateSequence2[n_,m_,start:{start1_,start2_},choices_]:=Module[{out,last, penultimate,new,pos2},
{penultimate,last}=out=start;
out=Reap[Do[
pos2=Mod[penultimate-last,n,1];
new=Mod[last+RandomChoice[choices[[pos2]]],n,1];
penultimate=last;
last=new;
Sow[new]
,
{m-2}
]][[2,1]];
Join[start,out]
]
Stamp[n_,choices_]:=Module[{},
Image[Normal[SparseArray[Thread[Join@@MapThread[Thread[{#1,#2}]&,{Range[Length[choices]],choices}]->1],{n,n}]]]
]
CreateSequenceImage2[n_,m_,start:{start1_,start2_},choices_]:=Module[{seq,pts,ras,stamp},
seq=CreateSequence2[n,m,start,choices];
pts=N@CirclePoints[n];
seq=FoldList[(#1+pts[[#2]])/2&,First[pts],seq];
ras=Rasterize[Graphics[{PointSize[0.001],Point[seq]},ImageSize->500,PlotRange->1],"Image",RasterSize->{300,300}];
stamp=ImagePad[Stamp[n,choices],1,Red];
ImageCompose[ras,stamp,{Center,Bottom},{Center,Bottom}]
]
Before looking at the general case, we can look at a small subset, namely one can **not** jump i ahead from the last, and j ahead from the penultimate. Here the example for i=1, and j =3:
ClearAll[JumpPos2]
JumpPos2[n_,{d1_,d2_}]:=Module[{pos},
pos=Range[n];
pos=DeleteCases[pos,d1];
DeleteCases[pos,Mod[d2+#,n,1]]&/@Range[n]
]
CreateSequenceImage2[4,10^4,{1,2},JumpPos2[4,{1,3}]]
![enter image description here][14]
Very neat structure! Of course we can try all i and j from the set {1,2,3,4}:
delta=Tuples[Range[4],2];
deltas=JumpPos2[4,#]&/@delta;
Grid[Join@@@Table[{{i,j},CreateSequenceImage2[4,10^4,{1,2},JumpPos2[4,{i,j}]]},{i,4},{j,4}],Frame->All]
![enter image description here][15]
All very neat, but it is just a small subset of the 50625 possibilities. Here let's try 64 random ones:
sc=Reverse@Subsets[Range[4],{1,\[Infinity]}];
Table[
CreateSequenceImage2[4,10^4,{1,2},RandomChoice[sc,4]]
,
{64}
] // Partition[#,8]& // ImageAssemble
![enter image description here][16]
As you can see very nice and rich structure! Notice that I 'stamped' all of them with their 'input':
CreateSequenceImage2[4, 10^4, {1, 2}, {{1, 4}, {3}, {1, 3, 4}, {1, 2, 3}}]
![enter image description here][17]
And if one looks closely (save the image and zoom), one will see the 'stamp' (or the rule) at the bottom:
![enter image description here][18]
This can be read as follows:
- The first (top) line, the white pixels are in places 1 and 4, so if the penultimate vertex was '1', move 1 or 4 places from the last vertex
- The 2nd line, the white pixel is in place 3, jump the position 3 ahead compared to last vertex
- 3rd line, white pixel at 1,3, and 4.
- 4th line 1, 2, or 3.
Basically the nth line corresponds to the position of the penultimate vertex. and the white pixels corresponds to 'allowed' number of jumps.
I'll stop here for now. There are many more ideas to explore, I'll name a few:
- <s>3D positions, 3D images</s> See below the post of Henrik!
- Anything other than regular polygons
- Have different probabilities for each of the vertices...
- Move in the perpendicular direction
- ...
See also the follow up posts [here.][19] and [here][20] and some additional visualizations below!
[1]: http://community.wolfram.com/groups/-/m/t/1039030
[2]: http://community.wolfram.com/groups/-/m/t/1047603
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=opener.png&userId=73716
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial1.png&userId=73716
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial2.png&userId=73716
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=3446trial3.png&userId=73716
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial4b.jpg&userId=73716
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial5.png&userId=73716
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial6.png&userId=73716
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial7.png&userId=73716
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial8.png&userId=73716
[12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=explanation-01.png&userId=73716
[13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial9.png&userId=73716
[14]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial10.png&userId=73716
[15]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial11.png&userId=73716
[16]: http://community.wolfram.com//c/portal/getImageAttachment?filename=5983trial12.png&userId=73716
[17]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial13.png&userId=73716
[18]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial14.png&userId=73716
[19]: http://community.wolfram.com/groups/-/m/t/1039030
[20]: http://community.wolfram.com/groups/-/m/t/1047603Sander Huisman2017-03-04T21:41:21ZQuestion in NSolve
http://community.wolfram.com/groups/-/m/t/1068072
I am working in a system of 8 equations and am trying to solve for 8 variables. I ran NSolve[{equations},{vars},Reals], and it just spat out my equations back at me. Am I missing something or using this routine incorrectly? Any help would be appreciated. Pasting my code below
Clear["Global'*"]; NSolve[{(
4 rin)/((kmn + 4) ((.25 wcr)^senc + 1) ((.25 wfr)^senf + 1)) -
36.923 ==
0, (7 rin)/((kmn + 7) ((.5 wcr)^senc + 1) ((.5 wfr)^senf + 1)) -
63.077 ==
0, (16 rin)/((kmn + 16) ((.75 wcr)^senc + 1) ((.75 wfr)^senf +
1)) - 147.962 ==
0, (46 rin)/((kmn + 46) (wcr^senc + 1) (wfr^senf + 1)) - 270.769 ==
0,
(4 rin)/((kmn + 4) ((.25 dcr)^senc + 1) ((.25 dfr)^senf + 1)) -
33.323 ==
0, (7 rin)/((kmn + 7) ((.5 dcr)^senc + 1) ((.5 dfr)^senf + 1)) -
83.446 ==
0, (16 rin)/((kmn + 16) ((.75 dcr)^senc + 1) ((.75 dfr)^senf +
1)) - 498.46 ==
0, (46 rin)/((kmn + 46) (dcr^senc + 1) (dfr^senf + 1)) - 1206.154 ==
0}, {rin, kmn, wcr, senc, wfr, senf, dcr, dfr},Reals]Josh Wofford2017-04-21T19:56:05ZSporadic convergence failure: “SingularValueDecomposition::cflsvd”
http://community.wolfram.com/groups/-/m/t/1065721
<b>Update 1</b> Per a request from Daniel Lichtblau at Wolfram Research, a minimal example has been uploaded to Google Drive as a pure-ASCII no-format `"m"`-file named [`"oneMatrixThatFailsSVD_2017.m"`][1]. The file is rather large (about 7.7 MBytes) because it encodes a convergence-failing `320x320` complex matrix as an integer byte-array of dimension `320x320x16`. This bit-perfect encoding "trick" is necessary because SVD convergence-failure seemingly is exquisitely sensitive to the least-significant bits of IEEE complex numbers (which are of course precisely the bits to which no well-conditioned SVD algorithm should be sensitive).
---
<b>Update 2</b> A comment has been added to the end of the above-mentioned text file [`"oneMatrixThatFailsSVD_2017.m"`][1] that provides the following (exact) pipe for flipping the least-significant-bit of complex matrices:
<code>
Flatten// (* complex square matrix -> complex list *)
ExportString[#,"Complex128"]&// (* complex list -> byte string *)
ExportString[#,"Base64"]&// (* byte string -> Base64 string *)
ByteArray[#]&//Normal// (* Base64 string -> integer list *)
Partition[#,16]&// (* integer list -> {...} *)
Partition[#,#//Length//Sqrt]&// (* {...} -> integer array *)
Map[(
{#[[1]]//If[#//EvenQ,#+1,#-1]&} ~ Join ~ (* flip LSB of real part *)
#[[2;;8]] ~ Join ~
{#[[9]]//If[#//EvenQ,#+1,#-1]&} ~ Join ~ (* flip LSB of imag part *)
#[[10;;16]]
)&,#,{2}]&//
Flatten// (* integer array -> integer list *)
ExportString[#,"Byte"]&// (* integer list -> byte string *)
ImportString[#,"Complex128"]&// (* byte string -> complex list *)
Partition[#,#//Length//Sqrt]&; (* complex list -> complex matrix *)
</code>
It turns out that flipping the least-significant bits of a convergence-failing input matrix <i>does</i> reproducibly eliminate the `"SingularValueDecomposition::cflsvd:"` message (which is behavior that no well-conditioned SVD algorithm should exhibit).
Hopefully this fine-grained, exactly reproducible control of the `"cflsvd"` SVD bug will make fixing it much easier in 2017 than back in 2005, when Mathematica tools like `ByteArray[__]` and `ExportString[_,"Complex128"]` were less-developed, such that the bug was more challenging to exhibit reproducibly and diagnose reliably.
----
<b>The bug in a nutshell:</b>&nbsp; for single-precision complex matrices, Mathematica's SingularValueDecomposition[] sporadically fails to converge.
The associated Mathematica-generated error message is:
SingularValueDecomposition::cflsvd: Machine-precision algorithm
failed to converge. Arbitrary-precision algorithm is called,
which is slower but more accurate.
This is a followup to a long-standing Mathematica bug report (specifically Wolfram Research bug report [TS 28968], submitted way back in 2005).
[This tarball][2] provides (in a folder named `"SVDfailures_2017"`) 25 examples of matrices whose convergence fails under Mathematica 10.2.0 for Mac OS X x86. The same tarball provides (in a folder named "`SVDfailures_2005`") matrices that fail under various versions of Mathematica dating back to 2005 (these files were provided with bug report [TS 28968]). The tarball is rather large (more than 100 MBytes) because it consists mostly of numerical matrices created with `"DumpSave[__]"`).
A principal difference between the 2005 failures and the 2017 failures is that (at least some of) the matrices that failed outright back in 2005, now generate the (undocumented?) convergence-failure message `"SingularValueDecomposition::cflsvd"`
To anticipate some questions:
- The arbitrary-precision evaluation does yield a correct decomposition, at the expense of a runtime that is 500-1000X longer.
- The matrices that fail of convergence are (seemingly) unremarkable in respect to numerical condition and rank.
- There is no reason (known to me at least) why SVDs of $\mathcal{O}(1)$-entry single-precision matrices should ever "fail to converge", and there is no linear algebra software other than Mathematica's (known to me) that exhibits a similar convergence failure.
My questions are:
- Does `"SingularValueDecomposition::cflsvd"` convergence-failure occur more generally, i.e., on systems other than Mathematica 10.2.0 for Mac OS X?
- What's the best way to report this bug (if it is a reproducible bug)?
[1]: https://drive.google.com/open?id=0ByYbFbzq4CGyZ3hobWZKb0U1TXM
[2]: https://drive.google.com/open?id=0ByYbFbzq4CGyNHBnMTRNeEMwTDAJohn Sidles2017-04-19T01:44:14ZHow do I use Solve to get an integer solution.
http://community.wolfram.com/groups/-/m/t/1068850
How do I get Mathematica to solve 3^(2x-1)=27 . if i type
Solve[3^(2x-1)==27,x]
I get a complex response which is obviously wrong since the answer is 3?Ray Lawicki2017-04-22T06:33:24ZThe Enigma Machine
http://community.wolfram.com/groups/-/m/t/1066381
Below is an implementation of the German Enigma Machine which the German forces used to communicate encrypted messages during WWII. The machine was an ingenious design. It used a series of rotors and an elaborate electromechanical coupling to encrypt messages in German.
About the mechanism, the first rotor moved with each click of the keyboard; the second rotor moved once the first rotor completed 26 moves or one complete turn; and the third rotor once the first moved 26*26 steps (one can easily understand where this is going).
Since the rotors could move during the encryption process the key to deciphering the text was the "key" or the initial state of the rotors. The code was finally broken by a team of cryptographers at Bletchley Park led by Alan Turing. Some believe this caused the war to shorten by a few years. A movie titled "The Imitation Game" was released in 2014 highlighting this code breaking feat.
ClearAll@rotateWheel;
SetAttributes[rotateWheel, HoldFirst];
rotateWheel[wheel_] := Block[{},
wheel = RotateLeft[wheel]];
The immediate block of code above enables me to make in-place modification i.e. to rotate and preserve the state of the rotors.
EnigmaEncryption[string_, staterot1_, staterot2_, staterot3_] :=
Module[{count = 0, RotorIn, leftRotor, middleRotor, rightRotor, reflector, reflectorOutput,
rotateMiddleCheck, rotateRightCheck, inputToNext, reverseOutput},
RotorIn = ToLowerCase@CharacterRange["A", "Z"];
{leftRotor, middleRotor, rightRotor} = MapThread[Function[{x, y}, (z \[Function]
RotateLeft[z, First@Position[z, ToLowerCase@y] - 1])@
Characters@ToLowerCase[x]], {{"BDFHJLCPRTXVZNYEIWGAKMUSQO",
"AJDKSIRUXBLHWTMCQGZNPYFVOE", "EKMFLGDQVZNTOWYHXUSPAIBRCJ"},
{staterot1, staterot2, staterot3}}];
reflector = Characters@ToLowerCase@"YRUHQSLDPXNGOKMIEBFZCWVJAT";
inputToNext[rotor_, input_] := First@Cases[Thread[{RotorIn, rotor}], {input, map_} :> map ];
reverseOutput[rotor_, input_] := First@Cases[Thread[{RotorIn, rotor}], {map_, input} :> map ];
rotateMiddleCheck := If[count~Mod~26 == 0, rotateWheel@middleRotor, middleRotor];
rotateRightCheck := If[count~Mod~676 == 0, rotateWheel@rightRotor, rightRotor];
StringJoin@Table[
If[FreeQ[input, Alternatives[" ", ",", "'", "?" ]],
count += 1;
reflectorOutput =
Fold[inputToNext[#2, #1] &, input, {rotateWheel@leftRotor, rotateMiddleCheck, rotateRightCheck, reflector}];
Fold[reverseOutput[#2, #1] &, reflectorOutput, {rightRotor, middleRotor, leftRotor}], input]
, {input, Characters@ToLowerCase@string}]
]
Now lets assume that the Germans encrypt a message with state "A", "A","A" for the three moving rotors:
Style[text = EnigmaEncryption["this is the SS, Identify yourself, are you a German or are you Alan Turing?", "A", "A", "A"], {Bold, FontSize -> 24}]
**uubf jw dif oo, jctjgmbn nbtqrang, pvs vsh o orgiya lq lyw svn ssui zcxuxs?**
If the cryptographers at Bletchley have the incorrect key "B","A","E" they will not be able to decipher the text (it will be gibberish).
Style[EnigmaEncryption[text, "B", "A", "E"], {Bold, FontSize -> 24}]
**pgyy yd gnu nw, etlisxnw fnkniizh, tgy wde u gqkabx ma foe alc aifb cmavmt?**
However, with the right key:
Style[EnigmaEncryption[text, "A", "A", "A"], {Bold, FontSize -> 24}]
**this is the ss, identify yourself, are you a german or are you alan turing?**
We can make a small animation of the rotor states. For visual purposes, blue represents the forward states of the system and red the backward state.
![enter image description here][1]
the code below can be used to generate the animation sequence:
list = (Rasterize@*Grid /@
Module[{out, states, mergedstates, rotorstates, riffle, first, last, text = text,
textout = StringReplace[text[[1]], Alternatives[" ", ",", "'", "?"] :> ""]},
out = Characters@textout;
states = Partition[text[[2, 1]], 7];
mergedstates = Table[Join[states[[i]], {out[[i]]}], {i, Length@states}];
rotorstates = text[[2, 2]];
riffle = MapAt[Reverse, (Partition[#, 4] & /@ mergedstates), {All, 2}];
riffle = Apply[Composition[Partition[#, 2] &, Riffle], riffle, {1}];
Do[{first, last} = Flatten@Position[rotorstates[[j, i]], #] & /@ riffle[[j, i]];
rotorstates[[j, i, first]] = Style[First@rotorstates[[j, i, first]], {Blue, Bold, Background -> LightBlue}];
rotorstates[[j, i, last]] = Style[First@rotorstates[[j, i, last]], {Red, Bold, Background -> LightRed}];
, {j, Length@riffle}, {i, 4}];
rotorstates
]);
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=1479animate.gif&userId=942204Ali Hashmi2017-04-20T02:10:34Z[GIF] Stay Upright (Projective view of Hopf circles)
http://community.wolfram.com/groups/-/m/t/1066393
![Projective view of Hopf circles][1]
**Stay Upright**
As with [_Light Show_][2], I'm starting with a collection of Hopf circles on the 3-sphere, taking the 2-planes in $\mathbb{R}^4$ they determine (note that a Hopf circle always determines a complex line in $\mathbb{C}^2$, so these 2-planes are complex lines), and intersecting those 2-planes with the hyperplane $w=1$, which gives a collection of lines in 3-space (actually in projective 3-space, but I'm just ignoring the lines at infinity). In _Light Show_ I was taking equally-spaced Hopf circles on the Clifford torus, whereas in this animation I'm taking a single circle on each of the tori interpolating between the unit circle in the $xy$-plane and the unit circle in the $zw$-plane (the unit circle in the $xy$-plane corresponds to a line at infinity; after the lines go off the screen they actually shoot off to infinity).
In fact, due to rendering issues I'm orthogonally projecting the lines in 3-space to the plane normal to what would be the `ViewPoint` vector if this were a `Graphics3D` object: hence the `viewpoint` and `plane` variables. Here's the code:
DynamicModule[{n = 60, a = π/4, viewpoint = {1, 1.5, 2.5}, θ = 1.19, r = 2.77, plane,
cols = RGBColor /@ {"#f43530", "#e0e5da", "#00aabb", "#46454b"}},
plane = NullSpace[{viewpoint}];
Manipulate[
Graphics[
{Thickness[.003],
Table[{Blend[cols[[;; -2]], r/π],
InfiniteLine[
RotationMatrix[θ].plane.# & /@ {{Cot[r] Csc[a], 0, Cot[a]}, {0, Cot[r] Sec[a], -Tan[a]}}]},
{r, π/(2 n) + s, π, 2 π/n}]},
Background -> cols[[-1]], PlotRange -> r, ImageSize -> 540],
{s, 0., 2 π/n}]
]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=hopf14.gif&userId=610054
[2]: http://community.wolfram.com/groups/-/m/t/1063215Clayton Shonkwiler2017-04-20T03:29:06ZPlot auto-extracted sub-matrices?
http://community.wolfram.com/groups/-/m/t/1067533
I have a 70x16 matrix ("DATA22K") in which the first column represents time, and the next 15 columns represent trials of a timecourse assay I've performed (n 1 thru 15). I would like to quickly create 15 submatrices with time (col 1) plotted against the values for each trial, each having iterated names of the format "Tr22Ki" (where i = 1 - 15). This is the code I'm using to generate the table of matrices (which seems to work):
Table[Evaluate[Symbol["Tr22K" <> ToString[i]]] ==
Transpose[{DATA22K[[All, 1]], DATA22K[[All, i]]}], {i, 2, 15, 1}];
**THE PROBLEM**: I used to be able to generate a graph with all Tr22Ki traces superimposed over each other with this code:
ListLinePlot[Tr22Ki]
but it no longer works (blank graph), and I can't figure out why. There is no error code, but I've checked, and all the matrices have been made. The same happens when I write the code as:
Tr22Kall=Table[Evaluate[Symbol["Tr22K" <> ToString[i]]] ==
Transpose[{DATA22K[[All, 1]], DATA22K[[All, i]]}], {i, 2, 15, 1}];
ListLinePlot[Tr22Kall]
Please help! Thank you for your time.Jesse Martin2017-04-21T00:47:10ZFormula for computing sqrt(2) of binary numbers.
http://community.wolfram.com/groups/-/m/t/1063480
In binary representation of $\sqrt{2}$ are there more ones or zeros?
$\sqrt{2}$ is an irrational number. Regardless what base numbering system youre using. There is no way to tell how many of each there are... because they go on forever.
The first so many
1.01101010000010...
no predictability, there shouldn't be any "pattern" to the binary representation of it, and therefore, statistically, the ratio of the numbers of 1s and 0s will approach 1.
**Is there a pattern?,So there is, and we will try to discover it.**
**How to find? well:**
Using this [identity][1]:
$$\lfloor x\rfloor =x-\frac{1}{2}+\frac{\sum _{k=1}^{\infty } \frac{\sin (2 k \pi x)}{k}}{\pi }$$
Solving sum :
Floor[x] == x - 1/2 + 1/Pi*Sum[Sin[2*k*Pi*x]/k, {k, 1, Infinity}]
$$\lfloor x\rfloor =-\frac{1}{2}+x-\frac{i \log \left(1-e^{-2 i \pi x}\right)}{2 \pi }+\frac{i \log \left(1-e^{2 i \pi x}\right)}{2 \pi }$$
At the first I'm find closed expression integer sequences of [OEIS A084188 ][2] and substitute $x=2^{n+\frac{1}{2}}$ to first equation.
Floor[x] == -(1/2) + x + ( I (Log[1 - E^(2 I \[Pi] x)] - Log[E^(-2 I \[Pi] x) (-1 + E^(2 I \[Pi] x))]))/(2 \[Pi]) /. x -> (Sqrt[2]*2^n)
$$\left\lfloor \sqrt{2} 2^n\right\rfloor =-\frac{1}{2}+2^{\frac{1}{2}+n}+\frac{i \left(-\log \left(1-e^{-i 2^{\frac{3}{2}+n} \pi }\right)+\log \left(1-e^{i 2^{\frac{3}{2}+n} \pi
}\right)\right)}{2 \pi }$$
a checks if works:
Table[-(1/2) + 2^(1/2 + n) + (I (Log[1 - E^(I 2^(3/2 + n) \[Pi])] - Log[E^(-I 2^(3/2 + n) \[Pi]) (-1 + E^(I 2^(3/2 + n) \[Pi]))]))/(2 \[Pi]) /. n -> m, {m, 0,
19}] // N // Chop // Rationalize
(*{1, 2, 5, 11, 22, 45, 90, 181, 362, 724, 1448, 2896, 5792, 11585, 23170, 46340, 92681, 185363, 370727, 741455, 1482910}*)
then I'm need solve for $b(n)$ from [equation][2] $\{a(0)=1,a(n+1)=2 a(n)+b(n+2)\}$
sol = RSolve[{b[n + 2] == a[n + 1] - 2*a[n], a[n] == -(1/2) + 2^(1/2 + n) + ( I (-Log[1 - E^(-I 2^(3/2 + n) \[Pi])] +
Log[1 - E^(I 2^(3/2 + n) \[Pi])]))/(2 \[Pi]), b[0] == 1, b[1] == 0}, {b[n], a[n]}, n]
sol2 = FullSimplify[b[n] /. sol[[1]], Assumptions -> {n > 0, n \[Element] Integers}]
$$B_n=\frac{i \left(-i \pi +2 \log \left(1-e^{-i 2^{-\frac{1}{2}+n} \pi }\right)-2 \log \left(1-e^{i 2^{-\frac{1}{2}+n} \pi }\right)-\log \left(1-e^{-i 2^{\frac{1}{2}+n} \pi
}\right)+\log \left(1-e^{i 2^{\frac{1}{2}+n} \pi }\right)\right)}{2 \pi } $$
We simplify $B_n$ expression to very simple form:
sol22=1/2 - (2 ArcTan[Cot[2^(-(3/2) + n) \[Pi]]])/\[Pi] + ArcTan[Cot[2^(-(1/2) + n) \[Pi]]]/\[Pi]
$$B_n=\frac{1}{2}-\frac{2 \tan ^{-1}\left(\cot \left(2^{-\frac{3}{2}+n} \pi \right)\right)}{\pi }+\frac{\tan ^{-1}\left(\cot \left(2^{-\frac{1}{2}+n}
\pi \right)\right)}{\pi }$$
**This is closed formula for the n-th digit in the binary representation of** $\sqrt{2}$ **for** $n > 0$ and $n\in \mathbb{Z}$
Table[sol22 /. n -> m, {m, 1, 50}] // Expand
$1, 0, 1, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0, 1, 1, 1, 1, 0, 0, 1$
checks if works:
mm = N[Sqrt[2], 16]; RealDigits[mm, 2][[1]]
$1, 0, 1, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0, 1, 1, 1, 1, 0, 0, 1, 1, 0, 1$
this last integer sequences can be found [here OEIS A004539][4].
Another test checking closed expression to numerical value for the square root of two of base-10 :
sol3 = Table[Block[{$MaxExtraPrecision = 10000}, N[Limit[sol22, n -> m], 10]], {m, 1, 600}] // Rationalize // Quiet
N[FromDigits[{Drop[sol3, 0], 1}, 2], 166]
$1.41421356237309504880168872420969807856967187537694807317667973799073\
2478462107038850387534327641572735013846230912297024924836055850737212\
644121497099935831413222666$
N[Sqrt[2], 166]
$1.41421356237309504880168872420969807856967187537694807317667973799073\
2478462107038850387534327641572735013846230912297024924836055850737212\
644121497099935831413222666$
At the end of post a interesting sum:
$$2 \sum _{n=1}^{\infty } \left(\frac{1}{2}-\frac{2 \tan ^{-1}\left(\cot \left(2^{-\frac{3}{2}+n} \pi \right)\right)}{\pi }+\frac{\tan
^{-1}\left(\cot \left(2^{-\frac{1}{2}+n} \pi \right)\right)}{\pi }\right) 2^{-n}=\sqrt{2}$$
N[2*Sum[(1/2 - (2 ArcTan[Cot[2^(-(3/2) + n) \[Pi]]])/\[Pi] + ArcTan[Cot[2^(-(1/2) + n) \[Pi]]]/\[Pi])*2^(-n), {n, 1, 164}], 50]
$1.4142135623730950488016887242096980785696718753769$
[1]: https://en.wikipedia.org/wiki/Floor_and_ceiling_functions
[2]: https://oeis.org/A084188
[3]: https://oeis.org/A084188
[4]: https://oeis.org/A004539Mariusz Iwaniuk2017-04-16T22:38:51ZGet all integration orders and plot them?
http://community.wolfram.com/groups/-/m/t/1066533
Hello,
I just downloaded Wolfram Mathematica and would like to know how to plot and get the integration limits in all orders. I know it can be done because I saw someone doing it in college and he was using Mathematica, probably an older version though. The volume described by the integrals are not defined using functions but as the sort:
![lR^3 solid description][1]
I went through the references and guides and could find regionplot3D function and others similar but all of them need the range for x,y and z. I'd like to be able to put the inequalities such as in the image and get all 6 possibles integrals to calculate. I don't know if i'm being clear :s
Also can I use wolfram cloud on my phone using the college's license? I tried to but apparently I have to pay for mathematica online (and app therefore). Can this (what I'm asking) be done in wolfram alpha or Matlab?
Thanks and excuse my english
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=integral.jpg&userId=1066194Mauro Pungo2017-04-19T21:22:40Z[✓] Create an animation of the Nephroid of Freeth?
http://community.wolfram.com/groups/-/m/t/1066315
Trying to create an animation of the Nephroid of Freeth with Mathematica
Clear[z];
a = 1;
Do[z[j] = PolarPlot[a*(1 + 2*Sin[t/2]), {t, 0, j}, Ticks -> False,
PlotRange -> {{-3, 1.5}, {-2.5, 2.5}}], {j, 4 Pi/50, 4 Pi, 4 Pi/50}];Mary Ann2017-04-19T17:02:09ZInterdependent optimization of two functions?
http://community.wolfram.com/groups/-/m/t/1065755
Hi,
I have a linear function with number of variables f(x1 x2, x3, x4 ...) which I want to minimize wrt the variables x1, x2 ...such that the sum of variables x1+x2+x3... also remains minimum.
I would be thankful for any suggestion regarding this interdependent double optimization problem.
thanks SGS G2017-04-19T07:34:01ZCreate a mesh out of a CAD file for FEM?
http://community.wolfram.com/groups/-/m/t/1066173
Hi everyone,
I have a 3D design of a spiral like shape made in AutoCAD (format: .dwg, .dfx). I need to make a series of FEM calculations (for which I haven't yet determined the equations) on that model using Mathematica..
I understand how to apply the FEM methods/functions to a mesh and obtain the desired results. But how do I use the shape in the CAD file as a mesh? I've managed to import the file and visualize the shape, but can I turn it to a convenient mesh in Mathematica?
Thank youDaniel Vilhena2017-04-19T15:27:01ZPlot a stream function?
http://community.wolfram.com/groups/-/m/t/1063855
Hi, I have problem to plot this equation
\[Psi](y,z)=( k[y]' z^2 (k[y]-z))/(8k[y] );
where
k[y]'=Sqrt[(1-k[y]/p)(1-k[y] p Cos[\[Alpha]]- k[y] Log[k[y]/p])]
and I am expected to get this kind of graph
![enter image description here][1]
I get k[y] from this
f[k_?NumericQ]:=p*NIntegrate[1/Sqrt[(1-t)(1-t p^2 Cos[\[Alpha]])-3 M p t Log[t]],{t,k/p,1}]
ky=FindRoot[y==f[k],{k,0}];
Table[{y,ky[[1,2]]},{y,0,a1+\[Delta],\[Delta]}]//N
where
p=1.57516;a1=1.7824;
Can anyone help me with this problem? Thanks in advance!
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=f.PNG&userId=862195Nurul Ainina2017-04-17T05:57:08ZDraw a ParametricPlot3D space curve as an arrow?
http://community.wolfram.com/groups/-/m/t/1063990
I have a space curve created by ParametricPlot3D. Something like:
plot = ParametricPlot3D[{Sin[u], Cos[u], u/(2*Pi)}, {u, 0, 2*Pi},
Axes -> None, ImageSize -> Medium];`
To turn that into an arrow, I use:
plotA = plot /. Line -> Arrow;
and can then display that plotA properly as an arrow by Show or Print.
But now I have to customize the arrow heads, e.g. use something like
Arrowheads[Small]
I can find no way to bring that into my plotA-arrow-curve. It seems that Arrowheads cannot be used as a Directive or Option for Show or the like. Instead it has to precede all Arrow graphics primitives. Probably I have to use a more intelligent form of the Replace-statement above. But I cannot find a legal form for replacing "Line" in plot by "Arrowheads[Small],Arrow" for plotA.
In any case I think that Replace-method is some kind of brute force for drawing a parametric curve as an arrow. Are there better ways?Werner Geiger2017-04-17T09:45:52ZFix recursive algorithm that doesn't call certain parts?
http://community.wolfram.com/groups/-/m/t/1064518
So I have the following code (fairly long), everything works so far as it asks me for values on certain inputs X,r,sigma,T (as it should) . Before that you to manually input the order of Taylor series expansion, and it then uses that to run the script for K=1,2,3..., how many you asked it to run,. and plots the following graph. However, at the end of the script you have (*Dimensionless analytic formula given by Kuske and Keller*), (*Dimensionless analytic formula given by Bunch and Johnson*), (*Dimensionless analytic formula given by Knessl*). I like the script to call Kuske and Keller,Bunch and Johnson, Knessl - formulas and possibly print them (?) and also to call them separately. Any help will be appreciated.
(* Using the new command of Mathematica 8.0. *)
Pade := PadeApproximant;
(* Define approx[f] for Taylor expansion of f *)
approx[f_] := Module[{temp},
temp[0] = Series[f, {t, 0, OrderTaylor}]//Normal;
temp[1] = temp[0] /. t^(n_.)*Derivative[j_][DiracDelta][0] -> 0;
temp[2] = temp[1] /. t^(n_.)*DiracDelta[0] -> 0;
temp[3] = temp[2] /. DiracDelta[0] -> 0;
temp[4] = temp[3] /. Derivative[j_][DiracDelta][0] -> 0;
temp[5] = N[temp[4],60]//Expand;
If[KeyCutOff == 1, temp[5] = temp[5]//Chop];
temp[5]
];
(* Define approx2[f] for Taylor expansion of f *)
approx2[f_] := Module[{temp},
temp[0] = Expand[f];
temp[1] = temp[0] /. Derivative[n_][DiracDelta][t] -> dd[n];
temp[2] = temp[1] /. DiracDelta[t] -> dd[0];
temp[3] = Series[temp[2],{t, 0, OrderTaylor}]//Normal;
temp[4] = temp[3] /. dd[0] -> DiracDelta[t];
temp[5] = temp[4] /. dd[n_] -> Derivative[n][DiracDelta][t];
temp[6] = N[temp[5],60]//Expand;
If[KeyCutOff == 1, temp[6] = temp[6]//Chop];
temp[6]
];
(* Define GetLK[n] *)
lamda := (1 - gamma)/2 - 1/2*Sqrt[(4 p + (1 + gamma)^2)];
kernel[s_] := -s^lamda/lamda;
lK0[0] = -1/lamda;
lK0[i_] := D[kernel[s], {s, i}] /. s -> 1 // Expand;
GetLK[m0_,m1_,Nappr_]:= Module[{temp,K1,K2,lK1,lK2},
For[i = Max[m0,0], i <= m1, i++,
K[i] = invl[lK0[i]];
K1[i] = K[i]/.{Derivative[_][DiracDelta][t_]->0,DiracDelta[t_]->0};
K2[i] = \
Collect[K[i]-K1[i],{DiracDelta[t],Derivative[Blank[]][DiracDelta][t]}];
temp = Series[K1[i],{t,0,Nappr}]//Normal;
lK1[i] = LaplaceTransform[temp, t, p];
lK2[i] = LaplaceTransform[K2[i],t, p];
LK[i] = Collect[lK1[i] + lK2[i], p];
];
];
(* define Getf[n] and Getg[n] *)
mu[m_,n_] := If[m == 1, b[n], Sum[mu[m-1,i]*b[n-i],{i,m-1,n-1}]];
psi[n_,m_] := dV[n,m]/m!;
alpha[n_,i_] := Sum[psi[n,m]*mu[m,i],{m,1,i}];
beta[n_,i_] := Sum[(m+1)*psi[n,m+1]*mu[m,i],{m,1,i}];
f[0] := 0;
g[0] := 1;
Getf[n_] := Sum[alpha[j,n-j],{j,0,n-1}];
Getg[n_] := Sum[beta[j,n-j] ,{j,0,n-1}];
(* Define Getb[n] *)
b[0] := 1;
BB[0] := 1;
B[0] := X;
Getb[n_] := Module[{temp},
If[n == 1,
b[1] = c0*dV[0, 0] // Expand,
temp = b[n - 1] + c0*(b[n - 1] + dV[n - 1, 0] + f[n - 1] )//Expand;
b[n] = approx[temp];
];
];
(* Define GetDV[m,n] *)
GetDV[m_, n_] := Module[{temp},
If[n == 1, DV[m, 1] = -g[m],
temp[1] = Expand[LK[n]*Lg[m]];
DV[m, n] = invl[temp[1]];
];
DV[m, n] = approx[DV[m, n]];
];
(* Define dV[m,n] *)
dV[m_,n_] := Module[{temp},
If[NumberQ[flag[m,n]],
Goto[100],
GetDV[m,n];
flag[m,n] = 1
];
Label[100];
DV[m,n]
];
(* Define hp[f_,m_,n_] *)
hp[f_,m_,n_]:= Module[{k,i,df,res,q},
df[0] = f[0];
For[k = 1, k <= m+n, k++, df[k] = f[k] - f[k-1]//Expand ];
res = df[0] + Sum[df[i]*q^i,{i,1,m+n}];
Pade[res,{q,0,m,n}]/.q->1
];
(* Get [m,n] Pade approximant of B *)
pade[order_]:= Module[{temp,s,i,j},
temp[0] = BB[order] /. t^i_. -> s^(2*i);
temp[1] = Pade[temp[0],{s,0,OrderTaylor,OrderTaylor}];
If[KeyCutOff == 1, temp[1] = temp[1]//Chop];
BBpade[order] = temp[1] /. s^j_. -> t^(j/2);
Bpade[order] = X*BBpade[order]/. t -> (sigma^2*t/2);
];
(*define the inverse Laplace transformation*)
invl[Sqrt[p]] := -1/(2*Sqrt[Pi]*t^(3/2));
invl[p^n_] := Module[{temp, nInt},
nInt = IntegerPart[n];
If[n > 1/2 && n > nInt,
Goto[100],
temp[2] = InverseLaplaceTransform[p^n, p, t];
Goto[200];
];
Label[100];
temp[1] = -1/2/Sqrt[Pi]/t^(3/2);
temp[2] = D[temp[1], {t, nInt}];
Label[200];
temp[2]//Expand
];
invl[d_./(c_. + a_.*Sqrt[4p + b_.])] := Module[{temp},
temp[1] = d/(4a)*Exp[-b*t/4];
temp[2] = 2/Sqrt[Pi*t];
temp[3] = c/a*Exp[c^2*t/(4a^2)]*Erfc[c*Sqrt[t]/(2a)];
temp[1]*(temp[2]-temp[3])//Expand
];
invl[d_./(p*(c_. + a_.*Sqrt[4p + b_.]))]:= Module[{temp},
temp[1] = Sqrt[b]*Erf[Sqrt[b*t]/2];
temp[2] = c/a*Exp[-(b-(c/a)^2)*t/4]*Erfc[c*Sqrt[t]/(2a)];
temp[3] = -1/(b - (c/a)^2)*d/a*(c/a-temp[1]-temp[2]);
temp[3]//Expand
];
invl[p^i_.*Sqrt[c_.*p + a_.]] := Module[{temp},
temp = D[-Exp[-a*t/c]/(2*c*Sqrt[Pi]*(t/c)^(3/2)),{t, i}];
temp//Expand
];
invl[Sqrt[c_.*p + a_.]] := -Exp[-a*t/c]/(2*c*Sqrt[Pi]*(t/c)^(3/2));
invl[f_] := InverseLaplaceTransform[f, p, t] // Expand;
invl[p_Plus] := Map[invl, p];
invl[c_*f_] := c*invl[f] /; FreeQ[c, p];
(* Main code *)
ham[m0_, m1_] := Module[{temp, k, n},
If[m0 == 1,
Print[" Strike price = ?"];
temp[0] = Input[];
If[!NumberQ[temp[0]],Goto[100]];
X = IntegerPart[temp[0]*10^10]/10^10;
Print[" Risk-free interest rate = ?"];
temp[0] = Input[];
If[!NumberQ[temp[0]],Goto[100]];
r = IntegerPart[temp[0]*10^10]/10^10;
Print[" Volatility = ?"];
temp[0] = Input[];
If[!NumberQ[temp[0]],Goto[100]];
sigma = IntegerPart[temp[0]*10^10]/10^10;
Print[" Time to expiry = ?"];
temp[0] = Input[];
If[!NumberQ[temp[0]],Goto[100]];
T = IntegerPart[temp[0]*10^10]/10^10;
gamma = 2*r/sigma^2;
texp = sigma^2*T/2;
Bp = X*gamma/(1 + gamma);
Label[100];
If[!NumberQ[gamma],
X = .;
r = .;
sigma = .;
gamma = .;
T = .;
];
Print["--------------------------------------------------------------"\
];
Print[" INPUT PARAMETERS: "];
Print[" Strike price (X) = ",X," ($) "];
Print[" Risk-free interest rate (r) = ",r];
Print[" Volatility (sigma) = ",sigma];
Print[" Time to expiry (T) = ",T," (year)"];
Print["--------------------------------------------------------------"\
];
Print[" CORRESPONDING PARAMETERS: "];
Print[" gamma = ",gamma];
Print[" dimensionless time to expiry (texp) = ",texp//N];
Print[" perpetual optimal exercise price (Bp) = ",Bp//N,"($)"];
Print["--------------------------------------------------------------"\
];
Print[" CONTROL PARAMETERS: "];
Print[" OrderTaylor = ",OrderTaylor];
Print[" c0 = ",c0];
Print["--------------------------------------------------------------"\
];
KeyCutOff = If[OrderTaylor < 80 && NumberQ[gamma], 1, 0];
If[KeyCutOff == 1,
Print["Command Chop is used to simplify the result"],
Print["Command Chop is NOT used "]
];
If[NumberQ[gamma],
Print["Pade technique is used"],
Print["Pade technique is NOT used"]
];
Clear[flag,DV];
];
For[k = Max[1, m0], k <= m1, k++,
Print[" k = ", k];
If[k == 1, GetKK[]; GetBJ[]; GetKn[]];
If[k == 1, Lg[0] = LaplaceTransform[g[0], t, p]];
If[k == 1, GetLK[0,2,OrderTaylor], GetLK[k+1,k+1,OrderTaylor]];
Getb[k];
BB[k] = Collect[BB[k - 1] + b[k], t];
temp[0] = X*BB[k] /. t-> (sigma^2*t/2)//Expand;
B[k] = Collect[temp[0],t];
If[NumberQ[gamma],pade[k]];
temp[1] = Getg[k];
temp[2] = Getf[k];
g[k] = approx2[temp[1]];
f[k] = approx2[temp[2]];
Lg[k] = LaplaceTransform[g[k], t, p];
If[NumberQ[gamma] && NumberQ[sigma] && NumberQ[X],
Print[" Optimal exercise price at the time to expiration = ", \
B[k]/.t->T//N];
Print[" Modified result given by Pade technique = \
",Bpade[k]/.t->T//N];
];
];
Print[" Well done !"];
If[NumberQ[gamma] && NumberQ[sigma] && NumberQ[X],
Plot[{Bp, B[m1], Bpade[m1]}, {t, 0, 1.25*T}, PlotRange -> {0.8*Bp, \
X},
PlotStyle ->{RGBColor[1, 0, 0], RGBColor[0, 1, 0], \
RGBColor[0, 0,1]}];
Print[" Order of homotopy-approximation : ",m1];
Print[" Green line : optimal exercise boundary B in polynomial "];
Print[" Blue line : optimal exercise boundary B by Pade method "];
Print[" Red line : perpetual optimal exercise price "];
];
];
(* Dimensionless analytic formula given by Kuske and Keller *)
GetKK[] := Module[{alpha},
alpha = -Log[9*Pi*gamma^2*t]/2;
KK0 = Exp[-2*Sqrt[alpha*t]];
KK = X*KK0 /. t->sigma^2/2*t;
];
(* Dimensionless analytic formula given by Kuske and Keller *)
GetBJ[] := Module[{alpha},
Bp0 = gamma/(1+gamma);
alpha = -Log[4*E*gamma^2*t/(2 - Bp0^2)]/2;
BJ0 = Exp[-2*Sqrt[alpha*t]];
BJ = X*BJ0 /. t->sigma^2/2*t;
];
(* Dimensionless analytic formula given by Knessl *)
GetKn[] := Module[{z},
z = Abs[Log[4*Pi*gamma^2*t]];
Kn0 = Exp[-Sqrt[2*t*z]*(1+1/z^2)];
Kn = X*Kn0 /. t->sigma^2/2*t;
];
(* Define the order of Tak b2017-04-17T15:32:42ZUnderstand different integration results with practically the same input?
http://community.wolfram.com/groups/-/m/t/1064471
Hi folks, Im new, so Im not sure this is the right place to drop my question.
In[1]: Integrate[Exp[-10 x]/(1 - (9/10) Exp[-10 x])^2, {x, 0, Infinity}]
Out[1]: 1
In[2]: Integrate[Exp[-10 x]/(1 - 0.9 Exp[-10 x])^2, {x, 0, Infinity}]
Out[2]: 1. - 1.10218*10^-15 i
My question is why in the second output I get that if the input is practically the same as In[1] (I just changed (9/10) for 0.9)
Thanks.Fernando Santos2017-04-18T01:52:41Z[✓] DirectedEdges invalid for small-world nor scale-free network generation
http://community.wolfram.com/groups/-/m/t/1064929
Dear Community,
I tried to generate a directed-edged small-world network using
RandomGraph[WattsStrogatzGraphDistribution[10, 0.4],
DirectedEdges -> True]
But was prompted that the call was made with invalid parameters. The same message was given for BarabasiAlbertGraphDistribution[10, 2].
Are the theories of small-world and scale-free networks not applicable to directed-edged networks? Or does just RandomGraph not allow these? For what reasons?
But RandomGraph generates directed-edged networks with BernoulliGraphDistribution and UniformGraphDistribution.Chi-Hsiang Wang2017-04-18T11:16:44ZSolve the following problem with boundary condition using version 11.01.?
http://community.wolfram.com/groups/-/m/t/1063072
I get error messages when attempting to solve this problem
It is easily solved if the conduction term (D[c[z, r], z, z]) and the corresponding boundary condition ( (D[c[z, r], z] /. z -> 1) == 0 )are removed ,however
it needs the conduction term in the system I want to simulate
eqns = {
(1 - r^2) r D[c[z, r], z] ==
0.1 (r D[c[z, r], r, r] + D[c[z, r], r] + D[c[z, r], z, z]) -
0.01 c[z, r],
c[0, r] == 0, (D[c[z, r], r] /. r -> 10^-6) == 0,
c[z, 0.999] == 1 - Exp[-1000 z^2],
(D[c[z, r], z] /. z -> 1) == 0};
u = NDSolveValue[eqns, c, {z, 0, 1}, {r, 10^-6, 0.999}]
Plot3D[u[z, r], {z, 0, 1}, {r, 10^-6, 0.999}, PlotRange -> {0, 1}]claygruesbeck2017-04-15T13:41:19Z