I'm using TwoAxisPlot to combine two plots for functions from an NDSolve, but the result has one of the curves truncated and is hence incomplete. I don't understand all the jargon when defining the TwoAxisPlot function so I don't know the origin of the problem. Code is as follows:
a = 0.99*10^-9;
b = 0.24*10^-3;
d = 1.21*10^-3;
T0 = 1*10^6;
n0 = 0.9*10^9;
ti = -20;
tf = 500;
kB = 1.38*10^-16;
Qb = 0.33*10^-3;
sig = 1;
var = sig^2;
Ag = 16.5;
Qg = Ag* Exp[-(t - 10)^2/(2*var)];
Qgt = Qg + Qb;
sss = NDSolve[{T'[t] == -(n[t]^-1) T[t]^(7/2) (a) -
n[t] T[t]^(-1/2) (b) + Qgt/(2*kB*n[t]),
n'[t] == T[t]^(5/2) (a) - (n[t]^2) (T[t]^(-3/2)) (d), T[ti] == T0,
n[ti] == n0}, {T, n}, {t, ti, tf}];
This gives me two interpolating functions which I can plot fully individually:
TP = Plot[T[t] /. sss, {t, ti, 300}, PlotRange -> All];
TPPa = Show[TP, Frame -> True,
FrameLabel -> {{"Temperature, K", ""}, {"Time, s", ""}}]
NP = Plot[n[t] /. sss, {t, ti, 300}, PlotRange -> All];
NPPa = Show[NP, Frame -> True,
FrameLabel -> {{"Density, \!\(\*SuperscriptBox[\(cm\), \(-3\)]\)",
""}, {"Time, s", ""}}]
I then define the TwoAxisPlot function, unchanged, copied from this website: Wolfram Documentation Center
TwoAxisPlot[{f_, g_}, {x_, x1_, x2_}] :=
Module[{fgraph, ggraph, frange, grange, fticks,
gticks}, {fgraph, ggraph} =
MapIndexed[
Plot[#, {x, x1, x2}, Axes -> True,
PlotStyle -> ColorData[1][#2[[1]]]] &, {f, g}]; {frange,
grange} = (PlotRange /. AbsoluteOptions[#, PlotRange])[[
2]] & /# {fgraph, ggraph}; fticks = N#FindDivisions[frange, 5];
gticks =
Quiet#Transpose#{fticks,
ToString[NumberForm[#, 2], StandardForm] & /#
Rescale[fticks, frange, grange]};
Show[fgraph,
ggraph /.
Graphics[graph_, s___] :>
Graphics[
GeometricTransformation[graph,
RescalingTransform[{{0, 1}, grange}, {{0, 1}, frange}]], s],
Axes -> False, Frame -> True,
FrameStyle -> {ColorData[1] /# {1, 2}, {Automatic, Automatic}},
FrameTicks -> {{fticks, gticks}, {Automatic, Automatic}}]]
and use it
TwoAxisPlot[{T[t] /. sss, n[t] /. sss}, {t, -20, 300}]
but the plot is now truncated and doesn't show the full curve. How can I fix this?
Add PlotRange -> Full as included below.
TwoAxisPlot[{f_, g_}, {x_, x1_, x2_}] := Module[
{fgraph, ggraph, frange, grange, fticks, gticks},
{fgraph, ggraph} = MapIndexed[Plot[#, {x, x1, x2}, Axes -> True,
PlotStyle -> ColorData[1][#2[[1]]], PlotRange -> Full] &, {f, g}];
{frange, grange} = (PlotRange /. AbsoluteOptions[#, PlotRange])[[2]] & /#
{fgraph, ggraph};
fticks = N#FindDivisions[frange, 5];
gticks = Quiet#Transpose#{fticks, ToString[NumberForm[#, 2],
StandardForm] & /# Rescale[fticks, frange, grange]};
Show[fgraph, ggraph /. Graphics[graph_, s___] :> Graphics[
GeometricTransformation[graph, RescalingTransform[{{0, 1}, grange},
{{0, 1}, frange}]], s], Axes -> False, Frame -> True,
FrameStyle -> {ColorData[1] /# {1, 2}, {Automatic, Automatic}},
FrameTicks -> {{fticks, gticks}, {Automatic, Automatic}}]]
Labeled[
TwoAxisPlot[{T[t] /. sss, n[t] /. sss}, {t, -20, 300}],
{Rotate["Temperature, K", Pi/2], "Time, s",
Rotate["Density, \!\(\*SuperscriptBox[\(cm\), \(-3\)]\)", Pi/2]},
{Left, Bottom, Right}]
Related
Is it possible to reproduce a meta-analysis type of flowchart as the one in the picture below using any R tool?
My attempt was using mermaid:
diagram = "
graph LR
subgraph Screening
b1-->b2
end
subgraph Eligibility
c1-->c2
end
subgraph Included
d1-->d2
end
subgraph Identification
a1-->a2
end
"
mermaid(diagram)
Which generated:
But I cannot find a way of connect the nodes accross the subgraphs.
Is there another tool better fitting to this kind of job? I am thinking on any package that I could use from within my Rmarkdown document.
I have found the DiagrammeR package easiest to do this. The general idea would be something like:
library(glue)
library(DiagrammeR)
excluded <- glue('Full text articles excluded
n = 1000
Reasons for exclusion
Reason 1
Reason 2')
grViz("
digraph cohort_flow_chart
{
node [fontname = Helvetica, fontsize = 12, shape = box, width = 4]
a[label = 'Records identified in original search']
b[label = 'Records identified with update']
c[label = 'Records after duplicates removed']
d[label = 'Records screened']
e[label = 'Records excluded']
f[label = 'Full text articles assessed']
g[label = 'Studies included']
h[label = '##1']
{ rank = same; a b}
{ rank = same; d, e}
{ rank = same; f, h}
a -> c;
b -> c;
c -> d;
d -> e [ minlen = 3 ];
d -> f;
f -> h [ minlen = 3 ];
f -> g;
}
[1]: excluded
")
Will look like:
Image with labels and empty nodes
grViz("
digraph cohort_flow_chart
{
node [fontname = Helvetica, fontsize = 12, shape = box, width = 4]
i[label = 'Identification', fillcolor = LightBlue,
style = filled, width = 2]
j[label = 'Screening',fillcolor = LightBlue, style = filled, width = 2]
k[label = 'Eligibility', fillcolor = LightBlue, style = filled,
width = 2]
l[label = 'Included', fillcolor = LightBlue, style = filled, width = 2]
a[label = 'Records identified in original search']
b[label = 'Records identified with update']
c[label = 'Records after duplicates removed']
d[label = 'Records screened']
e[label = 'Records excluded']
f[label = 'Full text articles assessed']
g[label = 'Studies included']
h[label = '##1']
blank_1[label = '', width = 0.01, height = 0.01]
blank_2[label = '', width = 0.01, height = 0.01]
blank_4[label = '', width = 4, color = White]
{ rank = same; a b i}
{ rank = same; blank_4 c j}
{ rank = same; f k}
{ rank = same; g l}
{ rank = same; blank_1 e}
{ rank = same; blank_2 h}
a -> c;
b -> c;
b -> blank_4 [ dir = none, color = White];
c -> d;
d -> blank_1 [ dir = none ];
blank_1 -> e [ minlen = 3 ];
blank_1 -> f;
f -> blank_2 [ dir = none ];
blank_2 -> h [ minlen = 3 ];
blank_2 -> g;
}
[1]: excluded
")
I'm trying to calculate determinants with any order using Lua. I can calculate determinants for order less than 4, but not for greater equals than 4 ones.
I have a 4x4 matrix and its determinant with the program is 0, but the real solution is 56.
I don't know if the problem is in getSubmatrix method or is in detMat method, because I don't have any error message from the console.
I've ported the methods from my own java code, where it works fine.
Here's all my code:
function numMat(n, A)
local S = {}
for i = 1, #A, 1 do
local T = {}
S[i] = T
for j =1, #A[1], 1 do
T[j] = n * A[i][j]
end
end
return S
end
function sumMat(A, B)
local C = {}
for i = 1, #A do
local D = {}
C[i] = D
for j = 1, #A[1] do
D[j] = A[i][j] + B[i][j]
end
end
return C
end
function subMat(A, B)
return sumMat(A, numMat(-1, B))
end
function printMatrix(A)
for i, v in ipairs(A) do
for j, w in ipairs(v) do
print(w)
end
end
end
function escalarProduct(u, v)
local w = 0
for i = 1, #u do
w = w + u[i] * v[i]
end
return w
end
function prodMat(A, B)
local C = {}
for i = 1, #A do
C[i] = {}
for j = 1, #B[1] do
local num = A[i][1] * B[1][j]
for k = 2, #A[1] do
num = num + A[i][k] * B[k][j]
end
C[i][j] = num
end
end
return C
end
function powMat(A, power)
local B = {}
local C = {}
C = A
for i = 1, power - 1 do
B = prodMat(C, A)
C = B
end
return B
end
function trasposeMat(A)
local B = {}
for i = 1, #A do
local C = {}
B[i] = C
for j = 1, #A[1] do
C[j] = A[j][i]
end
end
return B
end
function productDiag(m)
local prod = 1
for i = 1, #m do
for j = 1, #m do
if i == j then prod = prod * m[i][i] end
end
end
return prod
end
function isDiagonal(A)
for i = 1, #A do
for j = 1, #A do
if i ~= j and A[i][j] ~= 0 then return false end
end
end
return true
end
function isTriangSup(m)
for i = 1, #m do
for j = 1, i do
if m[i][j] == 0 then return true end
end
end
return false
end
function isTriangInf(m)
return isTriangSup(trasposeMat(m))
end
function isTriang(m)
if(isTriangSup(m)) then return true
else
return false
end
end
function getSubmatrix(A, rows, cols, col)
local submatrix = {}
local k = 1
for j = 1, cols do
--local D = {}
--submatrix[j] = D
if j == col then
break
end
for i = 2, rows do
submatrix[i-1][k] = A[i][j]
--D[k] = A[i][j]
end
k = k + 1
end
return submatrix
end
function det2Mat(A)
assert(#A == 2 and #A == #A[1], 'Error: The matrix must be squared, order 2.')
return A[1][1] * A[2][2] - A[1][2] * A[2][1]
end
function det3Mat(A)
assert(#A == 3 and #A == #A[1], 'Error: The matrix must be squared, order 3.')
s1 = A[1][1] * A[2][2] * A[3][3] + A[2][1] * A[3][2] * A[1][3] + A[1][2] * A[2][3] * A[3][1]
s2 = A[1][3] * A[2][2] * A[3][1] + A[1][2] * A[2][1] * A[3][3] + A[2][3] * A[3][2] * A[1][1]
return s1 - s2
end
function detMat(A)
local submatrix = {}
local det
local sign = 1
local rows = #A
local cols = #A[1]
assert(rows == cols, 'Error: The matrix must be squared.')
if rows == 1 then
return A[1][1]
end
if rows == 2 then
return det2Mat(A)
end
if rows == 3 then
return det3Mat(A)
end
if isDiagonal(A) or isTriang(A) then return productDiag(A) end
if rows > 3 then
for column = 1, cols do
submatrix = getSubmatrix(A, rows, cols, column)
det = det + sign * A[1][column] * detMat(submatrix)
sign = -sign
end
end
return det
end
A = {{1, 3}, {5, 6}}
B = {{2, 4}, {3, 1}}
C = {{2, 3, 4}, {-5, 4, 7}, {7, 1, 0}}
D = {{2, 0, 0, 0}, {0, 4, 0, 0}, {0, 0, 7, 0}, {0, 0, 0, 6}}
E = {{2, 3, 4, -3}, {-5, 4, 7, -2}, {7, 1, 0, 5}, {3, 4, 5, 6}}
--printMatrix(numMat(-1, A))
--printMatrix(sumMat(A, B))
--printMatrix(subMat(A, B))
--print(escalarProduct({1, 3}, {5, 6}))
--printMatrix(prodMat(A, B))
--printMatrix(trasposeMat(A))
--printMatrix(powMat(A, 2))
--printMatrix(powMat(A, 3))
print(detMat(A))
print(detMat(B))
print(detMat(C))
print(detMat(D))
print(detMat(E)) --The solution must be 56
And the console solution is:
-9
-10
1
336
0
The error is when I want to find out the determinant of the matrix E.
How can I make the plot for quantum harmonic oscillator using Mathematica?
I would like to draw similar looking plot like the attached figure.
Energy[n_] := (2 n + 1) ℏ/2 ω;
ψ[z_, n_] :=
1/2 1/Sqrt[2^n n!] ((m ω)/(π ℏ))^(1/4)
Exp[-((m ω z^2)/(2 ℏ))] HermiteH[n, Sqrt[(m ω)/ℏ] z];
m = 1;
ω = 1;
ℏ = UnitConvert[Quantity[1, "PlanckConstant"], "SIBase"];
ℏ = QuantityMagnitude[ℏ];
ℏ = 1;
Plot[{Evaluate#Table[Energy[n] + ψ[z, n], {n, 0, 5}],
Evaluate#Table[Energy[n], {n, 0, 5}], z^2/2}, {z, -5, 5},
PlotRange -> {0, 7},
PlotStyle ->
Join[{Red, Yellow, Green, Blue, Purple, Cyan},
Table[{Gray, Opacity[0.3]}, {n, 0, 5}], {Black}],
Filling -> {1 -> Energy[0], 2 -> Energy[1]}]
I can't find out how to draw a curved line between two rectangle using graphviz such as
digraph G {
SatisfactionF [style=filled, shape = rectangle]
SatisfactionM [style=filled, shape = rectangle]
Marital[shape = circle]
SatisfactionF -> Marital
SatisfactionM -> Marital
}
Here you go:
digraph G {
{
rank = same;
SatisfactionF [style=filled, shape = rectangle]
SatisfactionM [style=filled, shape = rectangle]
}
Marital[shape = circle]
SatisfactionF -> Marital
SatisfactionM -> Marital
SatisfactionF -> SatisfactionM [label = "0.4" tailport=n headport=n dir=both arrowhead=none]
}
It gives a warning but it works.
I am trying to solve a differential equation numerically but I need to vary y0 for my plot and view result for constant x. I can solve my equation normally as I expected:but I can't get result when I try for my real purpose as you can see
`\[Sigma] = 1;
n = 23.04;
Rop = y[x];
R = 0.5;
sz = R/(Rop + R);
F = -n*\[Sigma]*y[x]*(1 - 2*sz);
s = NDSolve[{y'[x] == F, y[0] == 0.8}, y, {x, 0, 0.07}]
Plot[Evaluate[y[x] /. s], {x, 0, 0.07}, PlotRange -> All,]`
`[Sigma] = 1;
n = 23.04;
Rop = y[x];
R = 0.5;
sz = R/(Rop + R);
F = -n*\[Sigma]*y[x]*(1 - 2*sz);
y0 = 0.8;
\!\(\*
ButtonBox["Array",
BaseStyle->"Link",
ButtonData->"paclet:ref/Array"]\)[s, 140]
i = 1;
For[i < 140,
s = NDSolve[{y'[x] == F, y[0] == y0}, y, {x, 0, 0.07}]
Plot[Evaluate[y[] /. s], x = 0.07, {y0, 0.8, 2.2}] // print
y0 == y0 + i*0.01];`
A variety of typos or misunderstandings
\[Sigma] = 1;
n = 23.04;
Rop = y[x];
R = 0.5;
sz = R/(Rop + R);
F = -n*\[Sigma]*y[x]*(1 - 2*sz);
y0 = 0.8;
For[i = 1, i < 140, i++,
s = NDSolve[{y'[x] == F, y[0] == y0}, y, {x, 0, 0.07}];
Plot[Evaluate[y[x] /. s], {x, 0, 0.07}] // Print;
y0 = y0 + i*0.01
];
Go through that and compare it a character at a time against your original.
After you have figured out why each of the changes were made then you can try to decide whether to put your Button back in that or not.