Community RSS Feed
http://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Wolfram Language sorted by active[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:23ZThe 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:21Z[FEATURE] Test if a graph is edge-weighted
http://community.wolfram.com/groups/-/m/t/1061356
It would be very useful to have a reliable function to check if a graph has edge weights.
One might naïvely think that `WeightedGraphQ` does this:
![enter image description here][1]
But that is not quite so. It will return `True` both when there are `EdgeWeight`s or `VertexWeight`s. I am not quite sure what is the use of this function, as I have not yet come across a situation where I would want to use `WeightedGraphQ` without also checking if the weights belong to edges or vertices.
*If you used `WeightedGraphQ` before and thought that it tested only for edge weights, upvote this post!*
How can we check if there are edge weights then? The best I could come up with is
PropertyValue[wg, EdgeWeight] =!= Automatic
**But:**
- Is this reliable? Given Mathematica's extremely flaky graph property handling, I am just not confident about it.
- If I have to use this, then what is the point of `WeightedGraphQ`? In what application do people care if the graph is weighted but not care if the weights belong to edges or vertices?
----
To show some of that flakiness, take a look at the documentation of all [the property handling functions][2], then see if you can make sense of any of this:
Could you have guessed that there are [so many different types of properties with different behaviours](http://mathematica.stackexchange.com/q/118196/12) and that custom properties are yet again different?
Now let's set some edge weights:
g = RandomGraph[{10, 20}];
wg = RandomGraph[{10, 20}, EdgeWeight -> Range[20]];
In[82]:= PropertyValue[g, EdgeWeight]
PropertyValue[wg, EdgeWeight]
Out[82]= Automatic
Out[83]= {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20}
So far so good. But this is an edge property, so this should work too:
PropertyValue[{g, First@EdgeList[g]}, EdgeWeight]
PropertyValue[{wg, First@EdgeList[wg]}, EdgeWeight]
The results are `$Failed` and `1`, again it makes sense.
Now let's set weights:
PropertyValue[
SetProperty[g, EdgeWeight -> {}],
EdgeWeight
]
(* Automatic *)
How does this make sense? `{}` should not be allowed. But when I use it, it is silently ignored, and does not change anything, either in `g` or `wg`.
Let's try to put some numbers in that list:
SetProperty[g, EdgeWeight -> {1, 2, 3}]
It returns unevaluated now. Why the difference from `{}`? Neither make sense here.
Let's try the weighted graph:
PropertyValue[
SetProperty[wg, EdgeWeight -> {1, 2, 3}],
EdgeWeight
]
(* {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, \
20} *)
Now it is silently ignored again. This is totally inconsistent.
Let's try giving `EdgeCount[g]` weights, as that should make sense.
In[96]:= PropertyValue[
SetProperty[g, EdgeWeight -> Reverse@Range[20]],
EdgeWeight
]
Out[96]= {20, 19, 18, 17, 16, 15, 14, 13, 12, 11, 10, 9, 8, 7, 6, 5, \
4, 3, 2, 1}
Good, it works.
Now try the weighted graph:
SetProperty[wg, EdgeWeight -> Reverse@Range[20]]
This returns unevaluated. What is going on?
OK, maybe you'll say that I need to set weights edge by edge instead of in bulk. And that indeed works. But if `PropertyValue` supports querying this property for the whole graph, then why doesn't `SetProperty` support setting it this way? Setting it edge by edge is not only terribly cumbersome, it is also very slow. How should I set it for *all* edges?
I guess I could use
weights = Reverse@Range[20];
Fold[SetProperty[{#1, First[#2]}, EdgeWeight -> Last[#2]] &, g, Transpose[{EdgeList[g], weights}]]
but is this seriously considered convenient or usable (even if we ignore performance)?
Also notice that when I used syntax which is arguably incorrect, there was never a single error or warning message. Sometimes there was no evaluation, which *should* usually trigger some problems further down the processing pipeline, but in other cases the weights were just silently ignored.
After seeing all this, are you still confident about your results when using graph properties? Either a tiny mistake you made, or some weird quirk of property handling could have introduced an error into your results.
If this were happening in version 8 (when `Graph`) was introduced or version 9, I could understand it. But the fact that 7 years after the introduction of `Graph` (and many bug reports sent to support) it is still like this sends a very discouraging message about whether people should use Mathematica for their network analysis (especially if they plan to publish results).
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Untitled-7.png&userId=38370
[2]: http://reference.wolfram.com/language/guide/Properties.htmlSzabolcs Horvát2017-04-13T11:58:05Z[Newbie] How do I define the output of a function as a new function?
http://community.wolfram.com/groups/-/m/t/1069944
Hey Guys!
I've got the following problem. I have the function
`f[a_,b_,c_]=a+b/c`
Now I'd like to set a new function
`g[a_,b_,c_]=D[f[a_,b_,c_],a_]`.
So the plan would be to have a new function which I can use to compute g for different a,b,c. For example I'd say `a=1 b=2 c=3` and Mathematica would tell me `g`. Obviously it does not work because i have the same variables on the right and on the left side. I've already googled my brain away but I found no solution. Do you have some advice for me?
I am sorry if I formatted something wrong, this is my first activity in the Wolfram community.
Thanks,
TobiasTobias Mitterdorfer2017-04-22T19:38:25ZSporadic 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:24Z[GIF] Horizon (Marching lines)
http://community.wolfram.com/groups/-/m/t/1070002
![Marching lines][1]
**Horizon**
This is essentially the exact same code as [_Stay Upright_][2]; the only real difference is that it's viewed from a different perspective.
Here's the code:
DynamicModule[{n = 100, a = π/4, viewpoint = {1, -1, 0}, θ = π, range = 8, plane,
cols = RGBColor /@ {"#F71735", "#FDFFFC", "#41EAD4", "#011627"}},
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 -> range, ImageSize -> 540],
{s, 0, 2 π/n}]
]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=hopf21.gif&userId=610054
[2]: http://community.wolfram.com/groups/-/m/t/1066393Clayton Shonkwiler2017-04-22T23:13:08ZListContourPlot
http://community.wolfram.com/groups/-/m/t/1069749
Hi,
I would like to change the order of interpolation of
ListContourPlot.
This function makes a linear interpolation...but I need of an interpolation order 3.
How could I do?
Thank you
Regardsmargherita ferrucci2017-04-22T14:24:18ZDoes Mathematica for Raspberry Pi have the full standard Mma functionality?
http://community.wolfram.com/groups/-/m/t/157817
I saw the annoucement of [url=http://www.wolfram.com/raspberry-pi/]Mathematica for Raspberry Pi[/url] today.
I was wondering if this version of Mathematica has all the functionality that is available in the commercial version of Mathematica. Or is it just a subset? (Mathematica 9 is much bigger than just [url=http://community.wolfram.com/groups/-/m/t/157340?p_p_auth=lZD0ficP]429 MB[/url].) I'm interested in kernel functionality mostly. I understand the the Predictive Interface is disabled to improve performance.
I would try it out, but I do not have a Raspberry Pi at this moment...Szabolcs Horvát2013-11-21T19:44:46ZThe 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:34ZCreate a GeoCoordinates converter with FormPage?
http://community.wolfram.com/groups/-/m/t/1069634
Hello, I'm having problems with the return of the result while converting from degree coordinates to decimal ones. I want to know where could be the problem, using Trace doesn't do the trick (Maybe I don't know how to use it propertly).
Here is the code I have been using:
CloudDeploy[FormPage["location" -> "GeoCoordinates", FromDMS[#location] &]]Jesus Teran2017-04-22T12:18:51ZChange density of ticks
http://community.wolfram.com/groups/-/m/t/1067780
Hello guys, I am doing bachelor with huge data sets (x: 0 , 800 000) ; (y: -55, 30)
I need to change density of ticks in _x axis but even with help I could find answer. :( I have never done Mathematica before and it seems little complicated for first time user. I want labels and grid to be 4x denser for better reading. Here is my graph
![enter image description here][1]
Can you please help? Thanks.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Capture.JPG&userId=11733Martin Dlabaja2017-04-21T18:50:53ZDeep Learning with Wolfram Neural Networks?
http://community.wolfram.com/groups/-/m/t/1065416
Is anyone interested in and actively using Wolfram to do Deep Learning research?
I am doing research in all areas of Deep Learning with my focus currently on VGG style of convolution neural networks (CNN). I will be branching out very soon to RLN, RNN, and GAN research very soon.
I would like to be able to compare experiences and lessons learned using Wolfram in these areas.
Thanks for any interest in discussions on Deep Learning.Bryan Minor2017-04-18T17:29:38ZAvoid Reddit's "Bad request" page using ServiceConnect["Reddit"]?
http://community.wolfram.com/groups/-/m/t/1066844
I'm sure there's some really simple thing I'm overlooking. When I enter this:
ServiceConnect["Reddit"]
...the WolframConnector dialog comes up, as expected. When I click the "Sign in to Reddit" button, Reddit opens to a "BAD REQUEST" page, with this message:
> you sent an invalid request — invalid redirect_uri parameter.
I never even get a chance to sign in. Am I overlooking something, or is there an option in Preferences somewhere that needs tweaking? Maybe a port the firewall is blocking? I'm stumped. I'm not doing anything fancy to get to Reddit. No VPN, no external router, nothing but the hotspot on my phone. I can generally access all of Reddit's services through Waterfox with no problem. I just can't connect Mathematica (Home Edition, 11.1.0) to Reddit.
Any ideas? Thanks in advance.Andrew Campbell2017-04-20T15:04:45Z[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:06ZImport data from a text file?
http://community.wolfram.com/groups/-/m/t/1068254
Hello everyone,
I have data files with the following form : "name of block 1", then 3 columns of data, then two blank lines, then second block and repeat.
I attached an example of such a file to this post.
I would like to open this file in a notebook, and generate lists with it. The name of the lists should be the name of the blocks (one list per block), and their content should be : { {X1, Y1}, {X2, Y2}, ...} such that Xi and Yi are the values in the two first columns of the blocks.
I know that should be feasible with the Import command, but I do not know exactly how...
Does someone has an idea for achieve that ? :)
Thank you very muchQuentin Marolleau2017-04-21T12:44:29Z[✓]Select with Cases certain elements of a list of rules (wavelet results)?
http://community.wolfram.com/groups/-/m/t/1067648
Hello,
I have this list, results of two wavelet analysis
aa = {{0} -> {1, 2, 3, 4}, {1} -> {4, 5, 6, 7}, {0, 0} -> {2, 4, 6,
8}, {0, 1} -> {5, 8, 9, 1}, {0, 0, 0} -> {2, 3, 8, 1}, {0, 0,
1} -> {2, 3, 1, 8}, {0, 1, 1} -> {8, 2, 1, 7},{0} -> {1, 2, 3, 4}, {1} -> {4, 5, 6, 7}, {0, 0} -> {2, 4, 6,
8}, {0, 1} -> {5, 8, 9, 1}, {0, 0, 0} -> {2, 3, 8, 1}, {0, 0,
1} -> {2, 3, 1, 8}, {0, 1, 1} -> {8, 2, 1, 7}}
I want to select only the associations where the first member is {0}, and {0,0}, and {0,0,0}, then select the associations where the first member contains the number 1 : {1}and {0,1},...
I have somme difficulties with associations
ThanksAndré Dauphiné2017-04-21T08:42:20ZPlot 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:10ZUse manipulate on variables in other equations?
http://community.wolfram.com/groups/-/m/t/1066233
The end goal of this endeavor is to make an interactive site where users import pictures then slide some manipulate bars to set parameters which selects things from the image. We start with binarizing the whole thing, filltransform the image to fill in the blobs, then selecting blobs of a set number of pixles. The sliders theoretically set the binarize threshhold, and the max & min pixel counts.
The problem I'm encountering is the manipulate command (or the sliders) will be used on a different line than the output line. The command that sets the max/min is not the output command that is used to display the picture. I tried making my program all on one line, but that was too long and too confusing and it didn't run properly with the manipulate command anyway (maybe I didn't write it right, but it doesn't seem like a feasible solution for me).
I'm thinking maybe I have to play with the dynamic command, to manipulate variables from previous lines? But that means I have to learn everything about dynamic, DynamicModule, and the rest of that can of worms...
im = THEFREAKINGPICTURE
isolate = FillingTransform@Binarize[im, {0, 0.36}]
selectsizes = Manipulate[Colorize[SelectComponents[WatershedComponents[GradientFilter[isolate, 2], isolate], "Area", minimum < # < maximum &]], {minimum, 0, 500}, {maximum, 500, 5000}]
circles =ComponentMeasurements[selectsizes, {"Centroid", "EquivalentDiskRadius", "Label"}];
Show[im, Graphics[{Red, Thick, Circle @@ # & /@ circles[[All, 2]]}]]
I want to put the 0.36 from my isolate command on a slider. I want to put minimum and maximum from my selectsizes command on a manipulate slider. I want to put all the sliders in a catch-all command at the end if that would work.... Basically all I want is have sliders for my variables that update the picture as needed. My brain has melted for today, and I have no idea how to make that work yet. If anyone has any helpful suggestions I would love to hear them, I'll be back at this tomorrow.Bill Norman2017-04-20T00:21:58Z[FEATURE] Remove edge weights (or other builtin property) from a graph
http://community.wolfram.com/groups/-/m/t/1060163
It would be very useful to have a function to remove `EdgeWeight` (or any other builtin property like `EdgeCapacity`) from a graph, without touching any other properties. I do not currently see a simple way to do this.
References:
* Removing edge weights is hard: https://mathematica.stackexchange.com/questions/5618/removing-edge-weights-from-a-graph
* There are several kinds of graph properties which tend to behave differently with various functions, and make such operations difficult (and hard to figure out): https://mathematica.stackexchange.com/questions/118196/which-are-the-standard-graph-properties
Please upvote if you ran into the same problem and feel a need for this feature.
If you do have a simple way to solve this simple and common problem, let me know. If you have a complicated, but reliable way, please still do let me know. I am interested in the shortest fully reliable solution.
----
My current best solution is
removeWeights[wg_?GraphQ] := Graph[VertexList[wg], EdgeList[wg], FilterRules[Options[wg], Except[EdgeWeight]]]
But I am not fully confident that this will not break in some edge case (or in some older version), and that it truly preserves all graph properties. As far as I can tell, this use of `Options` with `Graph` is not documented.
Is it also non-ideal because it changes the internal graph representation to `"Incidence"` (even if it was `"Simple"`), which I guess may have performance consequences. This can be checked using ``GraphComputation`GraphRepresentation``
*A confirmation that this is the current "right way" from a Wolfram developer would be most welcome!*Szabolcs Horvát2017-04-12T09:32:24ZFormula 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[GIF] Circle - Gecko - triangular tiling transformation inspired by Escher
http://community.wolfram.com/groups/-/m/t/870903
Inspired by the work of the Frisian artist M.C. Escher, I decided to make this little animation:
![enter image description here][1]
The code is nothing more than linear interpolation between sets of points:
SetDirectory[NotebookDirectory[]];
p1 = {{0.`,0.`},{0.0678`,0.054200000000000005`},{0.1336`,0.09570000000000001`},{0.1831`,0.1257`},{0.2398`,0.1714`},{0.26780000000000004`,0.20850000000000002`},{0.2528`,0.2606`},{0.22760000000000002`,0.3084`},{0.2117`,0.3584`},{0.21930000000000002`,0.41000000000000003`},{0.24550000000000002`,0.4595`},{0.28500000000000003`,0.5056`},{0.34`,0.48260000000000003`},{0.3935`,0.45320000000000005`},{0.4305`,0.43760000000000004`},{0.43820000000000003`,0.39840000000000003`},{0.4303`,0.3698`},{0.3831`,0.3678`},{0.3552`,0.3683`},{0.3925`,0.33180000000000004`},{0.4148`,0.2927`},{0.4339`,0.2671`},{0.49720000000000003`,0.2947`},{0.5356000000000001`,0.33380000000000004`},{0.5789000000000001`,0.3659`},{0.558`,0.4297`},{0.5141`,0.48090000000000005`},{0.5`,0.5`},{0.5`,0.5`},{0.4859`,0.5191`},{0.442`,0.5703`},{0.42110000000000003`,0.6341`},{0.46440000000000003`,0.6662`},{0.5028`,0.7053`},{0.5661`,0.7329`},{0.5852`,0.7073`},{0.6075`,0.6682`},{0.6448`,0.6317`},{0.6169`,0.6322`},{0.5697`,0.6302`},{0.5618000000000001`,0.6016`},{0.5695`,0.5624`},{0.6065`,0.5468000000000001`},{0.66`,0.5174`},{0.7150000000000001`,0.4944`},{0.7545000000000001`,0.5405`},{0.7807000000000001`,0.5900000000000001`},{0.7883`,0.6416000000000001`},{0.7724000000000001`,0.6916`},{0.7472000000000001`,0.7394000000000001`},{0.7322000000000001`,0.7915000000000001`},{0.7602`,0.8286`},{0.8169000000000001`,0.8743000000000001`},{0.8664000000000001`,0.9043`},{0.9322`,0.9458000000000001`},{1.`,1.`}};
p2 = {{1.`,1.`},{1.0396177978506647`,0.8923346254845568`},{1.0553148607198288`,0.8165562085782169`},{1.0612803330660763`,0.7422415758850744`},{1.0593972739777413`,0.6855070651494309`},{1.0410889377634256`,0.6295007686706042`},{0.9985803499841852`,0.5851973901977947`},{0.9483041434655642`,0.5486542747648014`},{0.9100397943346402`,0.495994821587507`},{0.8886126415052703`,0.4220994637695018`},{0.8802712781999131`,0.3410911444732952`},{0.9107680085914569`,0.2922860778674355`},{0.944118750413758`,0.23431580960507237`},{0.9891650545425124`,0.1782359561306078`},{1.0249726000191246`,0.2133888443460414`},{1.0610964405769812`,0.25639761969562114`},{1.0125267563571634`,0.29612575303974287`},{0.9819491132704178`,0.3427388211755879`},{1.042685124568772`,0.3779726220862235`},{1.0923875865214163`,0.4314412022155367`},{1.110695922735732`,0.3701240906516413`},{1.139236037043303`,0.307894872341834`},{1.1672759637805352`,0.24281899830083345`},{1.190159545123539`,0.19293999955865795`},{1.1550875696033072`,0.15058588147025714`},{1.1048113630846865`,0.1033990687684352`},{1.0520783529117537`,0.05681542343084531`},{1.`,0.`}};
rf = RotationTransform[\[Pi]/2, {1, 0}];
p3 = Reverse[rf /@ p2];
colors = {RGBColor[0.9280877328700329, 0.8058790727091572, 0.41541817087124444`],RGBColor[0.5551256603319519, 0.6745729914926235, 0.40725444158653856`]};
ClearAll[GetLines, MakeScene]
GetLines[\[Beta]_] :=
Module[{\[Alpha], goal1, goal2, goal3, goal, lenp},
If[0 <= \[Beta] <= 0.5,
\[Alpha] = 2 \[Beta];
lenp = Length[p1] + Length[p2] + Length[p3];
goal = CirclePoints[{0.66, 0.33}, {0.33, 3.97}, lenp];
{goal1, goal2, goal3} = FoldPairList[TakeDrop, goal, (Length /@ {p3, p2, p1})][[{3, 2, 1}]];
Polygon[Join @@ {\[Alpha] p1 + (1 - \[Alpha]) Reverse[
goal1], \[Alpha] p2 + (1 - \[Alpha]) Reverse[
goal2], \[Alpha] p3 + (1 - \[Alpha]) Reverse[ goal3]}]
,
\[Alpha] = 2 (\[Beta] - 0.5);
goal1 = Subdivide[0, 1, Length[p1] - 1];
goal1 = {goal1, goal1}\[Transpose];
goal2 = Subdivide[1, 0, Length[p2] - 1];
goal2 = Thread[{1, goal2}];
goal3 = Subdivide[1, 0, Length[p3] - 1];
goal3 = Thread[{goal3, 0}];
Polygon[Join @@ {(1 - \[Alpha]) p1 + \[Alpha] goal1, (1 - \[Alpha]) p2 + \
\[Alpha] goal2, (1 - \[Alpha]) p3 + \[Alpha] goal3}]
]
]
MakeScene[\[Alpha]_] := Module[{in, shape},
in = GetLines[\[Alpha]];
shape = {in, Rotate[in, \[Pi], {0.5, 0.5}]};
shape = Riffle[colors, shape];
shape = Rotate[shape, #, {0, 0}] & /@ Range[0, 3 \[Pi]/2, \[Pi]/2];
shape = Translate[shape, Tuples[{-2, 0, 2}, 2]];
shape
]
To animate it using manipulate use:
Manipulate[Graphics[MakeScene[\[Tau]], PlotRange -> 2.5], {\[Tau], 0, 1}]
And to output the animation I used:
n=150;
ClearAll[Nonlineartime]
Nonlineartime[t_]:=0.5LogisticSigmoid[25(t-0.2)]+0.5LogisticSigmoid[25(t-0.75)]
Plot[Nonlineartime[t],{t,0,1}]
ts=Table[Nonlineartime[t],{t,Subdivide[0.0,1,n]}];
ts[[{1,-1}]]={0.0,1.0};
imgs=Table[Rasterize[Graphics[MakeScene[t],PlotRange->2.5,ImageSize->400],"Image"],{t,ts}];
Export["geckotransform.gif",imgs~Join~Reverse[imgs],"DisplayDurations"->0.03]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=geckotransform.gif&userId=73716Sander Huisman2016-06-10T22:28:43ZUse SPI protocol with Arduino & ADC?
http://community.wolfram.com/groups/-/m/t/1029674
Hi, I'm interested in how I use SPI protocol.
In Mathematics documentation has information that might somehow use the SPI library in Arduino.
I have an Arduino Uno, and I want to connect ADC such as MAX 6675, with SPI protocol.
MAX 6675 is the ADC for temperature measurement using SPI protocol for sharing information, and there are several skeches to gather information from it.
I can not imagine how.
I am interested in whether someone has sample code to work with SPI protocol.Bohdan Romanchuk2017-03-12T23:08:59ZDo Visual Studio WSTP examples exist?
http://community.wolfram.com/groups/-/m/t/1066429
Hi all,
I am a long time Mathematica coder, and work in other functional languages. I am a passable user of C++, though this is usually quite pedestrian.
I've taken my second serious run at WSTP development today, and come up short. I wish to interface with an extensive existing C++ project, which is beyond my capacity to retool. My target was, using a modern version of visual studio, to compile one or both of the standard WSTP examples, addto, which calls out from mma, or factor, which calls in. I do not wish to ultimately compile via command line. This is as I want to proceed to integrate WSTP in a contained element of a complex program, which I am not equipped to modify the build targets or link structure of.
I would be very interested in hearing from anyone who has compiled any WSTP program from within visual studio.
I would be ecstatic to find out that a visual studio project exists that can be built out of the box.
Any and all commentary is very welcome,
DavidDavid Gathercole2017-04-19T19:46:59ZPossible bug: Map puts SparseArray in inconsistent state
http://community.wolfram.com/groups/-/m/t/1065699
It seems that `Map`ing a function over a `SparseArray` can produce a result where one of the explicit values in the array is the same as the background value. It seems to me that this is a bug because other functions appear to assume that an explicit value will never be the same as the background value.
## Example
Let us create a sparse array,
In[1]:= sa = SparseArray[{1, 0, 2, 0, 3}];
and check its explicit values.
In[2]:= sa["NonzeroValues"]
Out[2]= {1, 2, 3}
Let us now change the first element (which is nonzero) to have the background value.
In[3]:= sa[[1]] = 0;
And check explicit values again:
In[4]:= sa["NonzeroValues"]
Out[4]= {2, 3}
As you can see, the sparse array has been recomputed so that none of the explicit values is 0. It is in a consistent state. This is what I expected.
Now let us modify elements in a different manner. Let us map a function over the sparse array in such a way that it will transform some of the explicit values to zero:
In[5]:= sa = SparseArray[{1, 0, 2, 0, 3}];
In[6]:= sa2 = Map[If[# > 2, 0, #] &, sa];
Check explicit values in the result:
In[7]:= sa2["NonzeroValues"]
Out[7]= {1, 2, 0}
Oops! What is that `0` doing in the list? Is should have been removed from the explicit values list.
**Is this a bug?** Do decide, let us take a look at how other functions handle this sparse array.
`ArrayRules` works on both sparse and dense arrays. `ArrayRules[arr, b]` gives the positions of elements that are different from `b`. It works fine even if `b` is different from the background element of a sparse `arr`.
But here `ArrayRules` fails to give the result I expect, even though the second element was given explicitly:
In[8]:= ArrayRules[sa2, 0]
Out[8]= {{1} -> 1, {3} -> 2, {5} -> 0, {_} -> 0}
That `{5} -> 0` should not be in the list.
See how ArrayRules works if the default element is set to `1`. There is no problem this time:
In[9]:= ArrayRules[sa2, 1]
Out[9]= {{2} -> 0, {3} -> 2, {4} -> 0, {5} -> 0, {_} -> 1}
This suggests that either `ArrayRules` or `SparseArray` is misbehaving here. Which one should be considered the buggy one?
Does this `SparseArray` have a broken internal state? Or does `ArrayRules` fail to take a special case into account?
----
This array can be fixed using `SparseArray[sa2]`.Szabolcs Horvát2017-04-19T08:36:10Z[✓] 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:01ZLichtenberg Figures
http://community.wolfram.com/groups/-/m/t/1065956
Dear all,
![enter image description here][1]
Lichtenberg figures ([https://en.wikipedia.org/wiki/Lichtenberg_figure][2]) can be generated by irradiating e.g. PMMA (i.e. Poly(methyl methacrylate), "acrylic glass") with a high energy electron beam. This way electrons are implanted inside the material - which is an insulator. By a controlled discharge very aesthetic tree structures consisting of tracks from the electrical current can be generated. (This is just one method.)
It is fun trying to imitate this using Mathematica! The idea is simple:
- define a MeshRegion (this is all you need as input);
- convert it to a `Graph` (with preserved `VertexCoordinates` and `EdgeWeight`);
- use `FindShortestPath` to a specific "starting point".
As mentioned there is a simple mapping from a `MeshRegion` to the Lichtenberg graphics:
![enter image description here][3]
The code - a *short* notebook - comes as attachment.
And - due to the universally designed WL functions - it works in 3D without any change of code:
![enter image description here][4]
Best regards -- Henrik
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=lichtenberg.gif&userId=32203
[2]: https://en.wikipedia.org/wiki/Lichtenberg_figure
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Lichtenberg-Examples.png&userId=32203
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=LichtenberFigure3D.png&userId=32203Henrik Schachner2017-04-19T10:34:55ZPlot 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:42Z[FEATURE] Functions for graph property transformations
http://community.wolfram.com/groups/-/m/t/1062514
This is a proposal for adding functions that can transform or rename arbitrary graph properties, such as `EdgeWeight`s.
## Why?
When importing a graph that has properties, the properties will often be in an undesirable format. One may need to deal with missing values, string/number conversions, etc. It may also be necessary to re-map one property to another. Say, the graph may have a `"ws"` property that represents weights, and we may need to map it to Mathematica's standard `EdgeWeight`.
(Of course, a prerequisite to working with imported graphs is to improve the `Import` functionality a bit for several formats ...)
Another common problem is doing numerical transformations on edge weights. In some applications, a high weight value represents a strong connection. In others, it represents a long distance (e.g. `EdgeBetweennessCentrality`). Right now it is not easy to transform weights to have the appropriate properties.
Similarly, we may also want to transfer `EdgeWeight` to `EdgeCost` or `EdgeCapacity` to we can use them in with the appropriate functions.
## What interface?
We could have a simple `Map`-type function for transforming property values:
GraphPropertyMap[fun, graph, prop]
This would create a new graph, with `fun` applies to every property value of the property `prop`. For example, this would invert all weights:
GraphPropertyMap[1/#&, graph, EdgeWeight]
But I showed this only to introduce the idea. I would like to propose something more general instead.
An immediate useful generalization is a function comparable to `MapThread` that can combine values from multiple properties, and store them into a new one (or overwrite an old one). At this point, it will make sense to distinguish between edge and vertex properties. So I propose the following syntaxes:
EdgePropertyMap[fun, graph, prop]
would do the same as `GraphPropertMap` above, assuming `prop` is an edge property.
EdgePropertyMap[fun, graph, {p1, p2} -> p3]
would combine values from properties `p1` and `p2` to create `p3`. For example, let the `EdgeWeight` be the sum of properties `p1` and `p2`:
EdgePropertyMap[Plus, graph, {p1, p2} -> EdgeWeight]
(When a property value is not present for one particular edge, but it is for the other, `Missing[]` could be passed to the combiner function.)
This could also be used for renaming a property. E.g., transfer `EdgeWeight` to `EdgeCost`:
EdgePropertyMap[Identity, graph, EdgeWeight -> EdgeCost]
At this point we may allow a simplification, and just drop the function:
EdgePropertyMap[graph, EdgeWeight -> EdgeCost]
There should be no ambiguity since only one argument is `GraphQ` (first or second). But the exact syntax and order of argument is really just a detail ...
We may make it even nicer and let is use associations, so instead of `EdgePropertyMap[(#1 + #2) #3&, graph, {p1, p2, p3} -> p4]` we can write `EdgePropertyMap[(#p1 + #p2) #p3, graph, {p1, p2, p3} -> p4]`. (I am assuming here that property names must be symbols or strings, and the same name in symbol or string form is equivalent—just like with options) Though in my personal opinion, this is going a bit too far without giving a true benefit. Unnamed arguments should be fine too.
For full generality, I suggest that these functions should treat the following as "properties" too: `VertexList`, `EdgeList`, `VertexIndex`, `EdgeIndex`. These special properties would be readable, but not writeable (i.e. they can only appear on the LHS of the `->` in the third argument). This would allow taking into account the present edge or vertex name when transforming a property. E.g. we could have an exceptional case for certain vertices, or vertex indices larger than a threshold.
We could also do things like
VertexPropertyMap[Style[#, Bold, FontSize->14]&, graph, VertexList -> VertexLabels]
to easily create labels from names for each vertex. Or we could re-style existing labels:
VertexPropertyMap[Style[#, Italic]&, graph, VertexLabels]
Even more generally, instead of treating `EdgeList`, `EdgeIndex`, etc. as "properties", they could be *functions* that act on the graph and return a list of the same length as the `EdgeCount` or `VertexCount` (for `EdgeProprtyMap` and `VertexPropertyMap`, respectively). Then we could do:
VertexPropertyMap[2.5 Log[1 + #]&, graph, VertexDegree -> VertexSize]
to size vertices according to their degree.
There are lots of functions which could be used in this context, such as `VertexDegree`, `BetweennessCentrality`, `EdgeBetweennessCentrality`, etc.
I hope I convinced you that these would be extremely useful and versatile functions. They also fit well with Mathematica's philosophy of operating with general, high-level concepts. One simple function allows doing many different things without introducing ambiguity.
## Summary
I propose two functions, called `EdgePropertyMap` and `VertexPropertyMap` which are capable of:
- transforming a single graph property using a function
- combining multiple properties into new ones
- renaming a property, or transferring values from one property to another one
Notice that this concept works well with any type of graph, including mixed graphs (which I would rather see deprecated—but they wouldn't be a problem for these functions) and multigraphs ([which are currently unusable with most properties](http://community.wolfram.com/groups/-/m/t/1060237), except for a few built-in ones).
## Going further
We could go further and think about:
- How to use vertex properties to create edge properties, e.g. EdgeWeight based on VertexCoordinates (which I realize is now a graph-property, but this function could treat it as a vertex property).
- How to compute a vertex property based on the properties of neighbouring vertices
- What set of lower level functions makes all of this easier
This is too much for this post though, and brings up too many difficult questions that there isn't room for here. For example, if properties were usually handled as associations in the form `<| vertex1 -> value1, ..., vertexn -> valuen |>`, that would seemingly simplify lots of things. But we would again bump into the fundamental problem of [properties and parallel edges](http://community.wolfram.com/groups/-/m/t/1060237). That would have to be solved first by tweaking the design (e.g. refer to edges not solely by name, but by a combination of name and index? or index only?) So I do not want to go into this.
----
*Any comments on this design, or proof-of-concept implementations are most welcome! I am hoping that by actually demonstrating the usefulness of the concept, we can convince the decision makers at Wolfram to include these in the next version.*Szabolcs Horvát2017-04-14T12:08:10ZUnderstand 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:19ZEvaluate a variable inside an If clause?
http://community.wolfram.com/groups/-/m/t/1057573
This function
fn[x_]=Module[{ww},
ww=ArcTan[x];
If[x<ww, ww,(*else*) x ]
]
evaluates to
If[x < ArcTan[x], ww$375, x]
Why does the second occurrence of the local variable ww remain as a variable name instead of being evaluated like the first occurrence?Mark Alford2017-04-09T23:00:08Z