Mathematica Issue - wolfram-mathematica

Can someone who is familiar with mathematica tell me why my drawing wont generate?
plot1 = ContourPlot3D[{x^2 + (y + 0.25)^2 + (z - 0.45)^2 = 0.25,
x^2 + y^2 + (z + 0.5)^2 = 0.25,
x^2 + (y + 0.5)^2 + (z - 1.4)^2 = 0.25,
x^2 + (y + 0.25)^2 + (z - 2.35)^2 = 0.25,
x^2 + y^2 + (z - 3.3)^2 = 0.25,
x^2 + (y + 0.25)^2 + (z - 4.25)^2 = 0.25,
x^2 + (y + 0.5)^2 + (z - 5.2)^2 = 0.25,
x^2 + (y + 0.25)^2 + (z - 6.15)^2 = 0.25,
x^2 + y^2 + (z - 7.1)^2 = 0.25}, {x, -3, 3}, {y, -3, 3}, {z, -3, 3}]
plot2 = ContourPlot3D[{x^2 + (y - 0.5)^2 + (z - 0.25)^2 = 0.25,
x^2 + (y - 0.75)^2 + (z - 1.15)^2 = 0.25,
x^2 + (y - 1)^2 + (z - 2.05)^2 = 0.25,
x^2 + (y - 1.25)^2 + (z - 2.95)^2 = 0.25,
x^2 + (y - 1.5)^2 + (z - 3.85)^2 = 0.25,
x^2 + (y - 1.75)^2 + (z - 4.75)^2 = 0.25}, {x, -3, 3}, {y, -3,
3}, {z, -3, 3}]
plot3 = ContourPlot3D[{x^2 + (y + 0.5)^2 + z^2 = 0.25,
x^2 + (y + 1)^2 + (z - 0.75)^2 = 0.25,
x^2 + (y + 1.5)^2 + (z - 1.5)^2 = 0.25,
x^2 + (y + 2)^2 + (z - 2.25)^2 = 0.25}, {x, -3, 3}, {y, -3,
3}, {z, -3, 3}]
This error comes up three time once for each plot:
Set::write: Tag Plus in 7.56014\[VeryThinSpace]+8.99743\[VeryThinSpace]+11.8995
is Protected. >>
Set::write: Tag Plus in 6.24786\[VeryThinSpace]+8.99743\[VeryThinSpace]+8.99743
is Protected. >>
Set::write: Tag Plus in 6.24786\[VeryThinSpace]+8.99743\[VeryThinSpace]+19.3562
is Protected. >>
General::stop: Further output of Set::write will be suppressed during this calculation. >>

This is a small syntax error
The = symbol is used for Set (assignments and definitions)
The == symbol is used for Equal (equality checking)
so, in the body of each ContourPlot replace = with == and you are done
your code should be
plot1 = ContourPlot3D[{x^2 + (y + 0.25)^2 + (z - 0.45)^2 == 0.25,
x^2 + y^2 + (z + 0.5)^2 == 0.25,
x^2 + (y + 0.5)^2 + (z - 1.4)^2 == 0.25,
x^2 + (y + 0.25)^2 + (z - 2.35)^2 == 0.25,
x^2 + y^2 + (z - 3.3)^2 == 0.25,
x^2 + (y + 0.25)^2 + (z - 4.25)^2 == 0.25,
x^2 + (y + 0.5)^2 + (z - 5.2)^2 == 0.25,
x^2 + (y + 0.25)^2 + (z - 6.15)^2 == 0.25,
x^2 + y^2 + (z - 7.1)^2 == 0.25}, {x, -3, 3}, {y, -3, 3}, {z, -3,
3}]
etc.
yehuda

Related

Optimization in Mathematica

I am wondering if anyone could tell me the coding in mathematica. I have the Maple coding as follow:
with(Optimization):
objectiveFunction := 0.30x1 + 0.15x2
N: = 0.04x1 + 0.08x2 >= 25.4
P: = 0.08x1 + 0.04x2 >= 26.4
Solve(N,x2)
Solve(P,x2)
Plot([-0.5x1 + 320, -2x1 + 960], x1 = 200..1500, x2 = -200...1500)
You can set up the objective function and constraints almost as an in Maple, except that your symbols shouldn't start with capital letters, as those are reserved for Mathematica keywords, line N:
objectiveFunction = 0.30 x1 + 0.15 x2;
n = 0.04 x1 + 0.08 x2 >= 25.4;
p = 0.08 x1 + 0.04 x2 >= 26.4;
Then you can simply pass those to FindMinimum
{objectiveValue, solution} = FindMinimum[{objectiveFunction, n, p}, {x1, x2}]
Out[...] = {99., {x1 -> 228.333, x2 -> 203.333}}
(you can also use NMinimize; FindMinimum uses local, gradient based optimization methods like Newton's, NMinimize attempts global optimization. In this case, both functions should figure out that it's a linear programming problem.)
I'm not sure what your plot is doing, but I can try to visualize the result:
Show[
ContourPlot[objectiveFunction, {x1, 200, 1500}, {x2, -200, 1500}],
RegionPlot[n && p, {x1, 200, 1500}, {x2, -200, 1500},
PlotStyle -> Directive[White, Opacity[0.2]],
BoundaryStyle -> Directive[Red, Dashed]],
Graphics[{Red, PointSize[Large], Point[{x1, x2} /. solution]}]]

Converting x/y coordinates to spherical

Given a flat (equarectangilar panoramic) image of for instance 6000px x 3000px (spreading 360 degrees wide and 180 degree high). How would I translate for instance x = -10, y=-10 to spherical coordinates (pan/tilt or vertical/horizontal offset) where the center of the image would mean a horizontal/vertical offset of 0?
Is it possible to calculate this, or do you need other variables like the radius, distance or z coordinate?
Edit:
What I have so far:
def self.translate_xy_to_spherical(x, y)
h = (x / (6000 / 360)) - 180
v = ((y / (3000 / 180)) - 90) / - 1
[h, v]
end
def self.translate_spherical_to_xy(h, v)
x = ((h + 180) * (6000 / 360))
y = ((v * -1) + 90) * (3000/ 180)
[x, y]
end
If I put in 0,0 in the first method, I get -180,90 which is correct. But if I set 3000,0 I'd expect 0,90 but I get 7,90. Same goes with the other formula (xy to spherical). When I input 0,0 I'd expect 3000,1500 but I get 2880x1440px. There is a small offset, probally because I calculate in a straight line.
Update: The Answer
I've updated the answer from below to take in account that degrees could be bigger than 360 degrees. I use the modulo to fix this:
IMAGE_WIDTH = 6000
IMAGE_HEIGHT = 3000
def self.translate_xy_to_spherical(x, y)
h = (x / (IMAGE_WIDTH / 360.0)) - 180
v = ((y / (IMAGE_HEIGHT / 180.0)) - 90) / -1
[h, v]
end
def self.translate_spherical_to_xy(h, v)
x = (((h % 360) + 180) * (IMAGE_WIDTH / 360.0))
y = (((v % 180) * -1) + 90) * (IMAGE_HEIGHT/ 180.0)
[x, y]
end
Your equations are mathematically correct, but when dividing integers in Ruby (and in most languages), you will lose the remainder. For example 6000/360 = 16.666... in real life, but in Ruby you'll get 16. All these rounding errors will lead to errors in your final result. A trick to avoid this avoid this is to make some of the numbers in your arithmetic are Floats instead of just Fixnums. Try:
def self.translate_xy_to_spherical(x, y)
h = (x / (6000 / 360.0)) - 180
v = ((y / (3000 / 180.0)) - 90) / - 1
[h, v]
end
def self.translate_spherical_to_xy(h, v)
x = ((h + 180) * (6000 / 360.0))
y = ((v * -1) + 90) * (3000/ 180.0)
[x, y]
end

Drag the certain object on picbox doesn't drag the all image on it

I want to ask if it is possible to drag the image on picbox, when mouse cursor point to the certain object, so when I select the X-textbox, y-textbox, and select pin text
it will displat accourding my coordinate n pin number i selected.
But I want to drag them on picturebox. When mouse cursor touches that certain IC image, it can be drag. But not all the image on picbox drag together.
Can anyone give me some suggestion?
My full code below:
Option Explicit
Private mPic As Picture
Private mPicWidth As Single
Private mPicHeight As Single
Private mCurrentX As Single
Private mCurrentY As Single
Private mLeft As Single
Private mTop As Single
Private Sub Command5_Click()
Call draw_ic(Val(Text5), Val(Text6), Val(Text7))
End Sub
Private Sub Form_Load()
Picture1.AutoRedraw = True
Set mPic = Picture1.Image
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
mPicWidth = Me.ScaleX(mPic.Width, vbHimetric, Picture1.ScaleMode)
mPicHeight = Me.ScaleY(mPic.Height, vbHimetric, Picture1.ScaleMode)
ShowPictureAtPosition mLeft, mTop
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 0 Then
mCurrentX = X
mCurrentY = Y
ElseIf Button = vbLeftButton Then
ShowPictureAtPosition X + mLeft - mCurrentX, Y + mTop - mCurrentY
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
mLeft = X + mLeft - mCurrentX: mTop = Y + mTop - mCurrentY
End Sub
Private Sub ShowPictureAtPosition(pX As Single, pY As Single)
With Picture1
.Cls
.PaintPicture mPic, pX + 1, pY + 1, mPicWidth, mPicHeight
End With
End Sub
Function draw_ic(X, Y, pincount)
If pincount = 8 Then
Picture1.Line (X, Y)-(X + 120, Y + 48), vbBlack, B
Picture1.Line (X + 8, Y)-(X + 24, Y - 16), vbBlack, B
Picture1.Line (X + 34, Y)-(X + 50, Y - 16), vbBlack, B
Picture1.Line (X + 60, Y)-(X + 76, Y - 16), vbBlack, B
Picture1.Line (X + 86, Y)-(X + 102, Y - 16), vbBlack, B
Picture1.Line (X + 8, Y + 48)-(X + 24, Y + 64), vbBlack, B
Picture1.Line (X + 34, Y + 48)-(X + 50, Y + 64), vbBlack, B
Picture1.Line (X + 60, Y + 48)-(X + 76, Y + 64), vbBlack, B
Picture1.Line (X + 86, Y + 48)-(X + 102, Y + 64), vbBlack, B
ElseIf pincount = 12 Then
Picture1.Line (X, Y)-(X + 158, Y + 64), vbBlack, B
Picture1.Line (X + 8, Y)-(X + 16, Y - 8), vbBlack, B
Picture1.Line (X + 32, Y)-(X + 40, Y - 8), vbBlack, B
Picture1.Line (X + 56, Y)-(X + 64, Y - 8), vbBlack, B
Picture1.Line (X + 80, Y)-(X + 88, Y - 8), vbBlack, B
Picture1.Line (X + 104, Y)-(X + 112, Y - 8), vbBlack, B
Picture1.Line (X + 128, Y)-(X + 136, Y - 8), vbBlack, B
Picture1.Line (X + 8, Y + 64)-(X + 16, Y + 72), vbBlack, B
Picture1.Line (X + 32, Y + 64)-(X + 40, Y + 72), vbBlack, B
Picture1.Line (X + 56, Y + 64)-(X + 64, Y + 72), vbBlack, B
Picture1.Line (X + 80, Y + 64)-(X + 88, Y + 72), vbBlack, B
Picture1.Line (X + 104, Y + 64)-(X + 112, Y + 72), vbBlack, B
Picture1.Line (X + 128, Y + 64)-(X + 136, Y + 72), vbBlack, B
ElseIf pincount = 16 Then
Picture1.Line (X, Y)-(X + 222, Y + 72), vbBlack, B
Picture1.Line (X + 8, Y)-(X + 24, Y - 16), vbBlack, B
Picture1.Line (X + 34, Y)-(X + 50, Y - 16), vbBlack, B
Picture1.Line (X + 60, Y)-(X + 76, Y - 16), vbBlack, B
Picture1.Line (X + 86, Y)-(X + 102, Y - 16), vbBlack, B
Picture1.Line (X + 112, Y)-(X + 128, Y - 16), vbBlack, B
Picture1.Line (X + 138, Y)-(X + 154, Y - 16), vbBlack, B
Picture1.Line (X + 164, Y)-(X + 180, Y - 16), vbBlack, B
Picture1.Line (X + 190, Y)-(X + 206, Y - 16), vbBlack, B
Picture1.Line (X + 8, Y + 72)-(X + 24, Y + 88), vbBlack, B
Picture1.Line (X + 34, Y + 72)-(X + 50, Y + 88), vbBlack, B
Picture1.Line (X + 60, Y + 72)-(X + 76, Y + 88), vbBlack, B
Picture1.Line (X + 86, Y + 72)-(X + 102, Y + 88), vbBlack, B
Picture1.Line (X + 112, Y + 72)-(X + 128, Y + 88), vbBlack, B
Picture1.Line (X + 138, Y + 72)-(X + 154, Y + 88), vbBlack, B
Picture1.Line (X + 164, Y + 72)-(X + 180, Y + 88), vbBlack, B
Picture1.Line (X + 190, Y + 72)-(X + 206, Y + 88), vbBlack, B
End If
End Function
This is a very interesting project !
Consider the coordinates of the following image.
Every time that you create a new IC, if you save its top-left and bottom-right coordinates, it will help you to determine when the mouse pointer reaches its area by using the following code.
Private Function MouseCursorInsideRectangle(topLeftX As Integer, topLeftY As Integer, bottomRightX As Integer, bottomRightY As Integer, mouseX As Integer, mouseY As Integer) As Boolean
If mouseX >= topLeftX And mouseX <= bottomRightX And mouseY >= topLeftY And mouseY <= bottomRightY Then
MouseCursorInsideRectangle = True
Else
MouseCursorInsideRectangle = False
End If
End Function
This will resolve the issue of overlapping ICs, since you can check the coordinate of the IC that you want to draw and disallow the drawing, if it's over another one.
To solve the issue of moving only a certain IC and not the whole PictureBox image, you can clear the image when a drag event is in progress and draw all the ICs again (by using the coordinates that you saved during their creation) through iteration.
(Although it is not in your requirements, consider also saving the coordinates of the pins of each IC, so you can draw lines between ICs in the future).
EDIT
Try the below code
Option Explicit
Option Base 0
Private Type ICData
topLeftX As Integer
topLeftY As Integer
bottomRightX As Integer
bottomRightY As Integer
pinCount As Integer
End Type
Dim ICs() As ICData
Dim ICsIndex As Integer
Dim DraggedICIndex As Integer
Dim Xdifference As Integer
Dim Ydifference As Integer
Dim InitialX As Integer
Dim InitialY As Integer
Private Sub Form_Load()
ICsIndex = -1
DraggedICIndex = -1
Picture1.ScaleMode = 3
Picture1.AutoRedraw = True
End Sub
Private Sub Command5_Click()
Call save_ic(Val(text5), Val(text6), Val(text7))
Call draw_ics(-1)
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DraggedICIndex = GetICIndex(CSng(X), CSng(Y))
If DraggedICIndex > -1 Then
InitialX = ICs(DraggedICIndex).topLeftX
InitialY = ICs(DraggedICIndex).topLeftY
Xdifference = Abs(X - ICs(DraggedICIndex).topLeftX)
Ydifference = Abs(Y - ICs(DraggedICIndex).topLeftY)
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton And DraggedICIndex > -1 Then
Picture1.Cls
Call draw_ics(DraggedICIndex)
Call draw_ic(X - Xdifference, Y - Ydifference, ICs(DraggedICIndex).pinCount)
Dim ICWidth As Integer
Dim ICHeight As Integer
ICWidth = ICs(DraggedICIndex).bottomRightX - ICs(DraggedICIndex).topLeftX
ICHeight = ICs(DraggedICIndex).bottomRightY - ICs(DraggedICIndex).topLeftY
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If DraggedICIndex > -1 Then
Dim ICWidth As Integer
Dim ICHeight As Integer
ICWidth = ICs(DraggedICIndex).bottomRightX - ICs(DraggedICIndex).topLeftX
ICHeight = ICs(DraggedICIndex).bottomRightY - ICs(DraggedICIndex).topLeftY
ICs(DraggedICIndex).topLeftX = X - Xdifference
ICs(DraggedICIndex).topLeftY = Y - Ydifference
ICs(DraggedICIndex).bottomRightX = ICWidth + X - Xdifference
ICs(DraggedICIndex).bottomRightY = ICHeight + Y - Ydifference
End If
End Sub
Private Function MouseCursorInsideRectangle(location As ICData, mouseX As Integer, mouseY As Integer) As Boolean
If mouseX >= location.topLeftX And mouseX <= location.bottomRightX And mouseY >= location.topLeftY And mouseY <= location.bottomRightY Then
MouseCursorInsideRectangle = True
Else
MouseCursorInsideRectangle = False
End If
End Function
Private Function GetICIndex(mouseX As Integer, mouseY As Integer) As Integer
Dim i As Integer
For i = 0 To ICsIndex
If MouseCursorInsideRectangle(ICs(i), mouseX, mouseY) = True Then
GetICIndex = i
Exit Function
End If
Next
GetICIndex = -1
End Function
Sub save_ic(X, Y, pinCount)
If pinCount = 8 Then
ICsIndex = ICsIndex + 1
ReDim Preserve ICs(ICsIndex)
ICs(ICsIndex).topLeftX = X
ICs(ICsIndex).topLeftY = Y
ICs(ICsIndex).bottomRightX = X + 120
ICs(ICsIndex).bottomRightY = Y + 80
ICs(ICsIndex).pinCount = pinCount
ElseIf pinCount = 12 Then
ICsIndex = ICsIndex + 1
ReDim Preserve ICs(ICsIndex)
ICs(ICsIndex).topLeftX = X
ICs(ICsIndex).topLeftY = Y
ICs(ICsIndex).bottomRightX = X + 158
ICs(ICsIndex).bottomRightY = Y + 80
ICs(ICsIndex).pinCount = pinCount
ElseIf pinCount = 16 Then
ICsIndex = ICsIndex + 1
ReDim Preserve ICs(ICsIndex)
ICs(ICsIndex).topLeftX = X
ICs(ICsIndex).topLeftY = Y
ICs(ICsIndex).bottomRightX = X + 222
ICs(ICsIndex).bottomRightY = Y + 104
ICs(ICsIndex).pinCount = pinCount
End If
End Sub
Sub draw_ic(X, Y, pinCount)
If pinCount = 8 Then
Picture1.Line (X, Y + 16)-(X + 120, Y + 64), vbBlack, B
Picture1.Line (X + 8, Y + 16)-(X + 24, Y), vbBlack, B
Picture1.Line (X + 34, Y + 16)-(X + 50, Y), vbBlack, B
Picture1.Line (X + 60, Y + 16)-(X + 76, Y), vbBlack, B
Picture1.Line (X + 86, Y + 16)-(X + 102, Y), vbBlack, B
Picture1.Line (X + 8, Y + 64)-(X + 24, Y + 80), vbBlack, B
Picture1.Line (X + 34, Y + 64)-(X + 50, Y + 80), vbBlack, B
Picture1.Line (X + 60, Y + 64)-(X + 76, Y + 80), vbBlack, B
Picture1.Line (X + 86, Y + 64)-(X + 102, Y + 80), vbBlack, B
ElseIf pinCount = 12 Then
Picture1.Line (X, Y + 8)-(X + 158, Y + 72), vbBlack, B
Picture1.Line (X + 8, Y + 8)-(X + 16, Y), vbBlack, B
Picture1.Line (X + 32, Y + 8)-(X + 40, Y), vbBlack, B
Picture1.Line (X + 56, Y + 8)-(X + 64, Y), vbBlack, B
Picture1.Line (X + 80, Y + 8)-(X + 88, Y), vbBlack, B
Picture1.Line (X + 104, Y + 8)-(X + 112, Y), vbBlack, B
Picture1.Line (X + 128, Y + 8)-(X + 136, Y), vbBlack, B
Picture1.Line (X + 8, Y + 72)-(X + 16, Y + 80), vbBlack, B
Picture1.Line (X + 32, Y + 72)-(X + 40, Y + 80), vbBlack, B
Picture1.Line (X + 56, Y + 72)-(X + 64, Y + 80), vbBlack, B
Picture1.Line (X + 80, Y + 72)-(X + 88, Y + 80), vbBlack, B
Picture1.Line (X + 104, Y + 72)-(X + 112, Y + 80), vbBlack, B
Picture1.Line (X + 128, Y + 72)-(X + 136, Y + 80), vbBlack, B
ElseIf pinCount = 16 Then
Picture1.Line (X, Y + 16)-(X + 222, Y + 88), vbBlack, B
Picture1.Line (X + 8, Y + 16)-(X + 24, Y), vbBlack, B
Picture1.Line (X + 34, Y + 16)-(X + 50, Y), vbBlack, B
Picture1.Line (X + 60, Y + 16)-(X + 76, Y), vbBlack, B
Picture1.Line (X + 86, Y + 16)-(X + 102, Y), vbBlack, B
Picture1.Line (X + 112, Y + 16)-(X + 128, Y), vbBlack, B
Picture1.Line (X + 138, Y + 16)-(X + 154, Y), vbBlack, B
Picture1.Line (X + 164, Y + 16)-(X + 180, Y), vbBlack, B
Picture1.Line (X + 190, Y + 16)-(X + 206, Y), vbBlack, B
Picture1.Line (X + 8, Y + 88)-(X + 24, Y + 104), vbBlack, B
Picture1.Line (X + 34, Y + 88)-(X + 50, Y + 104), vbBlack, B
Picture1.Line (X + 60, Y + 88)-(X + 76, Y + 104), vbBlack, B
Picture1.Line (X + 86, Y + 88)-(X + 102, Y + 104), vbBlack, B
Picture1.Line (X + 112, Y + 88)-(X + 128, Y + 104), vbBlack, B
Picture1.Line (X + 138, Y + 88)-(X + 154, Y + 104), vbBlack, B
Picture1.Line (X + 164, Y + 88)-(X + 180, Y + 104), vbBlack, B
Picture1.Line (X + 190, Y + 88)-(X + 206, Y + 104), vbBlack, B
End If
End Sub
Sub draw_ics(exceptICIndex As Integer)
If ICsIndex > -1 Then
Dim i As Integer
For i = 0 To ICsIndex
If i <> exceptICIndex Then
Call draw_ic(ICs(i).topLeftX, ICs(i).topLeftY, ICs(i).pinCount)
End If
Next
End If
End Sub
I leave the IC overlap implementation on you :).

Adding parametricplot3d in only z axis

I am trying to add this parametric plot only in the z-axis (right now when I add it expands in the x,y, and z), the effect of this summation would be addition of amplitudes of the sine waves. Here is what I have now. http://imgur.com/j9hN7VR
Here is the code I am using to implement it:
frequency = 1000;
speed = 13397.2441;
wavelength = speed/frequency;
s = (r - 2);
t = (r - 4);
u = (r - 6);
v = (r - 8);
ParametricPlot3D[{{r*Cos[q] - 4, r*Sin[q], Sin[(2*Pi)/wavelength*(r)]},
{s*Cos[q] - 2, s*Sin[q], Sin[(2*Pi)/wavelength*(s + wavelength/4 - 1)]},
{t*Cos[q], t*Sin[q], Sin[(2*Pi)/wavelength*(t + wavelength/4 + 0.5)]},
{u*Cos[q] + 2, u*Sin[q], Sin[(2*Pi)/wavelength*(u + wavelength/4 + 1.65)]},
{v*Cos[q] + 4, v*Sin[q], Sin[(2*Pi)/wavelength*(v + wavelength/4 + 3.5)]}},
{r, 0, 25}, {q, 0, Pi}, PlotPoints -> 30, Mesh -> 20, PlotRange -> {{-25, 25}, {0, 35}, {-6, 6}}]
Any suggestions would be greatly appreciated!
Unfortunately I could not find an answer for this, so I ended up just simulating in MATLAB instead by generating all values over the field (in a matrix) and then summing as I was trying to do here.

Transform(align) a plane plot into a 3D plot in Mathematica

I have an ODE and I solve it with NDSolve, then I plot the solution on a simplex in 2D.
Valid XHTML http://ompldr.org/vY2c5ag/simplex.jpg
Then I need to transform (align or just plot) this simplex in 3D at coordinates (1,0,0),(0,1,0),(0,0,1), so it looks like this scheme:
Valid XHTML http://ompldr.org/vY2dhMg/simps.png
I use ParametricPlot to do my plot so far. Maybe all I need is ParametricPlot3D, but I don't know how to call it properly.
Here is my code so far:
Remove["Global`*"];
phi[x_, y_] = (1*x*y)/(beta*x + (1 - beta)*y);
betam = 0.5;
betaf = 0.5;
betam = s;
betaf = 0.1;
sigma = 0.25;
beta = 0.3;
i = 1;
Which[i == 1, {betam = 0.40, betaf = 0.60, betam = 0.1,
betaf = 0.1, sigma = 0.25 , tmax = 10} ];
eta[x2_, y2_, p2_] = (betam + betaf + sigma)*p2 - betam*x2 -
betaf*y2 - phi[x2, y2];
syshelp = {x2'[t] == (betam + betaf + sigma)*p2[t] - betam*x2[t] -
phi[x2[t], y2[t]] - eta[x2[t], y2[t], p2[t]]*x2[t],
y2'[t] == (betaf + betam + sigma)*p2[t] - betaf*y2[t] -
phi[x2[t], y2[t]] - eta[x2[t], y2[t], p2[t]]*y2[t],
p2'[t] == -(betam + betaf + sigma)*p2[t] + phi[x2[t], y2[t]] -
eta[x2[t], y2[t], p2[t]]*p2[t]};
initialcond = {x2[0] == a, y2[0] == b, p2[0] == 1 - a - b};
tmax = 50;
solhelp =
Table[
NDSolve[
Join[initialcond, syshelp], {x2, y2, p2} , {t, 0, tmax},
AccuracyGoal -> 10, PrecisionGoal -> 15],
{a, 0.01, 1, 0.15}, {b, 0.01, 1 - a, 0.15}];
functions =
Map[{y2[t] + p2[t]/2, p2[t]*Sqrt[3]/2} /. # &, Flatten[solhelp, 2]];
ParametricPlot[Evaluate[functions], {t, 0, tmax},
PlotRange -> {{0, 1}, {0, 1}}, AspectRatio -> Automatic]
Third day with Mathematica...
You could find a map from the triangle in the 2D plot to the one in 3D using FindGeometricTransformation and use that in ParametricPlot3D to plot your function, e.g.
corners2D = {{0, 0}, {1, 0}, {1/2, 1}};
corners3D = {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}};
fun[pts1_, pts2_] := FindGeometricTransform[Append[pts2, Mean[pts2]],
PadRight[#, 3] & /# Append[pts1, Mean[pts1]],
"Transformation" -> "Affine"][[2]]
ParametricPlot3D[Evaluate[fun[corners2D, corners3D][{##, 0}] & ### functions],
{t, 0, tmax}, PlotRange -> {{0, 1}, {0, 1}, {0, 1}}]
Since your solution has the property that x2[t]+y2[t]+p2[t]==1 it should be enough to plot something like:
functions3D = Map[{x2[t], y2[t], p2[t]} /. # &, Flatten[solhelp, 2]];
ParametricPlot3D[Evaluate[functions3D], {t, 0, tmax},
PlotRange -> {{0, 1}, {0, 1}, {0, 1}}]

Resources