So I am fairly new to Mathematica and I have been having trouble finding a way of displaying three dimensional data in a bar structure in Mathematica. However, the best that I can do to represent my data.
My data is formatted in a way that I have a three coordinate structure for all of the points but I want to have each individual point represented. The data is as follows:
{0, 220, 0.05}, {0, 230, 0.33}, {0, 230, 0}, {0, 230, 0},
{0, 250, 1.04}, {0, 250, 0.26}, {0, 250, 1.01}, {0, 250, 4.83}, {0, 250, 0},
{0, 270, 2.69}, {10, 220, 0.6}, {10, 240, 1.28}, {10, 250, 0.97},
{15, 250, 0.25}, {15, 270, 3.52}
How can I make the graph a three dimensional graph with each coordinate point (all three axes) represented in its individual bar on the graph as opposed to a plane?
not sure what you are after -- note ListPlot3D doesn't work really right because some of your points are on top of each other..
Show[{ListPlot3D[data ], Graphics3D[{PointSize[.1], Point[data]}]}]
Show[Graphics3D#{Cuboid[{Append[#[[1 ;; 2]], 0] +
{2, 2, 0}, # - {2, 2, 0}}] & /# data}, Axes -> True,
AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}},
BoxRatios -> {1, 2, .5}]
ListPointPlot3D[{{0, 220, 0.05}, {0, 230, 0.33}, {0, 230, 0}, {0, 230,
0}, {0, 250, 1.04}, {0, 250, 0.26}, {0, 250, 1.01}, {0, 250,
4.83}, {0, 250, 0}, {0, 270, 2.69}, {10, 220, 0.6}, {10, 240,
1.28}, {10, 250, 0.97}, {15, 250, 0.25}, {15, 270, 3.52}},
Filling -> Bottom, DataRange -> All]
Is this what you want?
Suppose I have a series of strips of paper placed along an infinite ruler, with start and end points specified by pairs of numbers. I would like to create a list representing the number of layers of paper at points along the ruler.
For example:
strips =
{{-27, 20},
{ -2, -1},
{-47, -28},
{-41, 32},
{ 22, 31},
{ 2, 37},
{-28, 30},
{ -7, 39}}
Should output:
-47 -41 -27 -7 -2 -1 2 20 22 30 31 32 37 39
1 2 3 4 5 4 5 4 5 4 3 2 1 0
What is the most efficient, clean, or terse way to do this, accommodating Real and Rational strip positions?
Here's one approach:
Clear[hasPaper,nStrips]
hasPaper[y_, z_] := Piecewise[{{1, x <= z && x >= y}}, 0];
nStrips[y_, strip___] := Total#(hasPaper ### strip) /. x -> y
You can get the number of strips at any value.
Table[nStrips[i, strips], {i, Sort#Flatten#strips}]
{1, 2, 3, 3, 3, 4, 5, 5, 5, 5, 5, 5, 4, 3, 2, 1}
Also, plot it
Plot[nStrips[x, strips], {x, Min#Flatten#strips, Max#Flatten#strips}]
Here is one solution:
In[305]:=
strips = {{-27, 20}, {-2, -1}, {-47, -28}, {-41, 32}, {22, 31}, {2,
37}, {-28, 30}, {-7, 39}};
In[313]:= int = Interval /# strips;
In[317]:= Thread[{Union[Flatten[strips]],
Join[Count[int, x_ /; IntervalMemberQ[x, #]] & /# (Mean /#
Partition[Union[Flatten[strips]], 2, 1]), {0}]}]
Out[317]= {{-47, 1}, {-41, 2}, {-28, 2}, {-27, 3}, {-7, 4}, {-2,
5}, {-1, 4}, {2, 5}, {20, 4}, {22, 5}, {30, 4}, {31, 3}, {32,
2}, {37, 1}, {39, 0}}
EDIT Using SplitBy and postprocessing the following code gets the shortest list:
In[329]:=
strips = {{-27, 20}, {-2, -1}, {-47, -28}, {-41, 32}, {22, 31}, {2,
37}, {-28, 30}, {-7, 39}};
In[330]:= int = Interval /# strips;
In[339]:=
SplitBy[Thread[{Union[Flatten[strips]],
Join[Count[int, x_ /; IntervalMemberQ[x, #]] & /# (Mean /#
Partition[Union[Flatten[strips]], 2, 1]), {0}]}],
Last] /. {b : {{_, co_} ..} :> First[b]}
Out[339]= {{-47, 1}, {-41, 2}, {-27, 3}, {-7, 4}, {-2, 5}, {-1,
4}, {2, 5}, {20, 4}, {22, 5}, {30, 4}, {31, 3}, {32, 2}, {37,
1}, {39, 0}}
You may regard this as a silly approach, but I'll offer it anyway:
f[x_]:=Sum[UnitStep[x-strips[[k,1]]]-UnitStep[x-strips[[k,2]]],{k,Length[strips]}]
f/#Union[Flatten[strips]]
f[u_, s_] := Total[Piecewise#{{1, #1 <= x < #2}} & ### s /. x -> u]
Usage
f[#, strips] & /# {-47, -41, -27, -7, -2, -1, 2, 20, 22, 30, 31, 32, 37, 39}
->
{1, 2, 3, 4, 5, 4, 5, 4, 5, 4, 3, 2, 1, 0}
For Open/Closed ends, just use <= or <
Here's my approach, similar to belisarius':
strips = {{-27, 20}, {-2, -1}, {-47, -28}, {-41, 32}, {22, 31}, {2,
37}, {-28, 30}, {-7, 39}};
pw = PiecewiseExpand[Total[Boole[# <= x < #2] & ### strips]]
Grid[Transpose[
SplitBy[SortBy[Table[{x, pw}, {x, Flatten[strips]}], First],
Last][[All, 1]]], Alignment -> "."]
Here's my attempt - it works on integers, rationals and reals, but makes no claim to being terribly efficient. (I made the same mistake as Sasha, my original version did not return the shortest list. So I stole the SplitBy fix!)
layers[strips_?MatrixQ] := Module[{equals, points},
points = Union#Flatten#strips;
equals = Function[x, Evaluate[(#1 <= x < #2) & ### strips]];
points = {points, Total /# Boole /# equals /# points}\[Transpose];
SplitBy[points, Last] /. {b:{{_, co_}..} :> First[b]}]
strips = {{-27, 20}, {-2, -1}, {-47, -28}, {-41, 32}, {22, 31},
{2, 37}, {-28, 30}, {-7, 39}};
In[3]:= layers[strips]
Out[3]= {{-47, 1}, {-41, 2}, {-27, 3}, {-7, 4}, {-2, 5}, {-1, 4}, {2, 5},
{20, 4}, {22, 5}, {30, 4}, {31, 3}, {32, 2}, {37, 1}, {39, 0}}
In[4]:= layers[strips/2]
Out[4]:= {{-(47/2), 1}, {-(41/2), 2}, {-(27/2), 3}, {-(7/2), 4},
{-1, 5}, {-(1/2), 4}, {1, 5}, {10, 4}, {11, 5}, {15, 4}, {31/2, 3},
{16, 2}, {37/2, 1}, {39/2, 0}}
In[5]:= layers[strips/3.]
Out[5]= {{-15.6667, 1}, {-13.6667, 2}, {-9., 3}, {-2.33333, 4}, {-0.666667, 5},
{-0.333333, 4}, {0.666667, 5}, {6.66667, 4}, {7.33333, 5}, {10.,4},
{10.3333, 3}, {10.6667, 2}, {12.3333, 1}, {13., 0}}
Splice together abutting strips, determine key points where number of layers
changes, and calculate how many strips each key point inhabits:
splice[s_, {}] := s
splice[s_, vals_] := Module[{h = First[vals]},
splice[(s /. {{x___, {k_, h}, w___, {h, j_}, z___} :> {x, {k, j},
w, z}, {x___, {k_, h}, w___, {h, j_}, z___} :> {x, {k, j}, w,
z}}), Rest[vals]]]
splicedStrips = splice[strips, Union#Flatten#strips];
keyPoints = Union#Flatten#splicedStrips;
({#, Total#(splicedStrips /. {a_, b_} :> Boole[a <= # < b])} & /# keyPoints)
// Transpose // TableForm
EDIT
After some struggling I was able to remove splice and more directly eliminate points that did not need checking (-28, in the strips data we've been using) :
keyPoints = Complement[pts = Union#Flatten#strips,
Cases[pts, x_ /; MemberQ[strips, {x, _}] && MemberQ[strips, {_, x}]]];
({#, Total#(strips /. {a_, b_} :> Boole[a <= # < b])} & /# keyPoints)
One approach of solving this is converting the strips
strips = {{-27, 20}, {-2, -1}, {-47, -28}, {-41, 32}
,{ 22, 31}, { 2, 37}, {-28, 30}, {-7, 39}}
to a list of Delimiters, marking the beginning or end of a strip and sort them by position
StripToLimiters[{start_, end_}] := Sequence[BeginStrip[start], EndStrip[end]]
limiterlist = SortBy[StripToLimiters /# strips, First]
Now we can map the sorted limiters to increments/decrements
LimiterToDiff[BeginStrip[_]] := 1
LimiterToDiff[EndStrip[_]] := -1
and use Accumulate to get the intermediate totals of intersected strips:
In[6]:= Transpose[{First/##,Accumulate[LimiterToDiff/##]}]&[limiterlist]
Out[6]= {{-47,1},{-41,2},{-28,3},{-28,2},{-27,3},{-7,4},{-2,5},{-1,4}
,{2,5},{20,4},{22,5},{30,4},{31,3},{32,2},{37,1},{39,0}}
Or without the intermediate limiterlist:
In[7]:= StripListToCountList[strips_]:=
Transpose[{First/##,Accumulate[LimiterToDiff/##]}]&[
SortBy[StripToLimiters/#strips,First]
]
StripListToCountList[strips]
Out[8]= {{-47,1},{-41,2},{-28,3},{-28,2},{-27,3},{-7,4},{-2,5},{-1,4}
,{2,5},{20,4},{22,5},{30,4},{31,3},{32,2},{37,1},{39,0}}
The following solution assumes that the layer count function will be called a large number of times. It uses layer precomputation and Nearest in order to greatly reduce the amount of time required to compute the layer count at any given point:
layers[strips:{__}] :=
Module[{pred, changes, count}
, changes = Union # Flatten # strips /. {c_, r___} :> {c-1, c, r}
; Evaluate[pred /# changes] = {changes[[1]]} ~Join~ Drop[changes, -1]
; Do[count[x] = Total[(Boole[#[[1]] <= x < #[[2]]]) & /# strips], {x, changes}]
; With[{n = Nearest[changes]}
, (n[#] /. {m_, ___} :> count[If[m > #, pred[m], m]])&
]
]
The following example uses layers to define a new function f that will compute the layer count for the provided sample strips:
$strips={{-27,20},{-2,-1},{-47,-28},{-41,32},{22,31},{2,37},{-28,30},{-7,39}};
f = layers[$strips];
f can now be used to compute the number of layers at a point:
Union # Flatten # $strips /. s_ :> {s, f /# s} // TableForm
Plot[f[x], {x, -50, 50}, PlotPoints -> 1000]
For 1,000 layers and 10,000 points, the precomputation stage can take quite a bit of time, but individual point computation is relatively quick:
I'm making a small interface for calculating voltage dividers in Mathematica. I have two sliders (z1 & z2) that represent the resistor values and a couple of sliders to represent Vin as a sinusoid.
The issue is that the range of available resistor values (in the real world) is roughly logarithmic on {r, 100, 1,000,000}. If I set my slider range to r, however, it's impractical to select common low resistor values in approx. {100, 10,000}.
Is it possible to create a slider that sweeps through a logarithmic range?
Manipulate[
Grid[{{Plot[(VinRCos[t] + VinC), {t, -3, 9},
PlotRange -> {-1, VMax}, AxesLabel -> {t, Vin}]}, {Plot[
z2/(z1 + z2)(VinR*Cos[t] + VinC), {t, -3, 9},
PlotRange -> {-1, VMax}, AxesLabel -> {t, Vout}]}},
ItemSize -> 20],
{{z1, 10000}, 10, 1000000, 10}, {z1}, {{z2, 10000}, 10,
1000000}, {z2}, Delimiter, {{VinR, 2.5}, 0,
5}, {VinR}, {{VinC, 2}, -VMax, VMax}, {VinC}]
Michael's answer is probably the best, i.e. just get the user to specify the exponent. An alternate solution is to make a LogSlider type command. Here's a simple example:
LogSlider[{v:Dynamic[var_], v0_?Positive}, {min_?Positive, max_?Positive},
base_:10, options___] := DynamicModule[{ev}, Dynamic[
var = base^ev;
Slider[Dynamic[ev], Log[base, {min, max}]]]]
LogSlider[v:Dynamic[var_], {min_?Positive, max_?Positive},
base_:10, options___] := LogSlider[{v, min}, {min, max}]
The function only has a subset of the flexibility of Slider and will have to be extended if you want custom step sizes etc...
You then modify your Manipulate by specifying the variables using
{{z1, 10000}, 10, 1000000, LogSlider[##]&} etc...
A simple fix is to just make the slider manipulate the exponent, and plug in e.g. 10^z1 where you need the actual value:
Manipulate[10^z1, {{z1, 5}, 2, 6}] (* 100 to 1M *)
In your particular case, you could of course also input a list of standard resistor values to pick from:
Manipulate[z1, {z1, {100, 110, 120, 130, 150, 160, 180, 200, 220, 240, 270}}]
HTH!
Here is my final result:
Manipulate[
Evaluate[Round[10^Z2]/(Round[10^Z1] + Round[10^Z2])*Vin] "V",
{{Z1, 5}, 2, 6},
Pane["Z1 = " Dynamic[Round[10^Z1] "[CapitalOmega]"],
ImageMargins -> {{2.5, 0}, {3, 0}}],
{{Z2, 5}, 2, 6},
Pane["Z2 = " Dynamic[Round[10^Z2] "[CapitalOmega]"],
ImageMargins -> {{2.5, 0}, {0, -5}}], {{Vin, 2.5}, 0, VMax},
Pane["Vin = " Dynamic[Vin "V"], ImageMargins -> {{0, 0}, {0, -5}}]]
Here is a start to LogSlider that produces the standard two-way behavior the other controls have.
LogSlider[Dynamic[x_], max_] :=
Module[{exp},
Dynamic[exp = Log[max, x];
Slider[Dynamic[exp, (exp = #; x = max^exp) &]]]]
{LogSlider[Dynamic#x, 10^6], Dynamic#x}