abritac
(Abrita Chakravarty)
April 20, 2020, 3:25pm
1
During week two of the Wolfram Study Group Apr 2020 (WSG20) we are looking at the following topics from Stephen Wolfram’s book Elementary Introduction to the Wolfram Language :
Day 10 : Chapter 4: Displaying Lists, Chapter 7: Colors and Styles, Chapter 8: Basic Graphics Objects
Day 11 : Chapter 10: Images, Chapter 14: Coordinates and Graphics, Chapter 24: More Forms of Visualization
Day 12 : Chapter 37: Layout and Display, Chapter 9: Interactive Manipulation
Day 13 : Project of the Week and Wolfram U specials.
We are looking at videos from the Wolfram U interactive course on EIWL and also working on simple exercises and mini projects.
Feel free to post questions on the material we covered in these sessions here.
2 Likes
abritac
(Abrita Chakravarty)
April 20, 2020, 3:38pm
2
Daily challenge (Day 10): Here is an interesting read on how “The Wolfram Language Bridges Mathematics and the Arts ”. For today’s challenge post an interesting piece of graphics you created with the Wolfram Language.
2 Likes
vaungureanu
(Valeriu Ungureanu)
April 20, 2020, 6:47pm
3
A simple modification of an example from the EIWL:
Style[Circle[{#, 0}, #], Hue[0.01 #^2]] & /@ Range[0, 10, .01] // Graphics
or
Style[Circle[{0.1 Cos@#, 0.9 Sin@#}, #], Hue[0.0091 #^2]] & /@
Range[0, 11.5, .01] // Graphics
4 Likes
abritac
(Abrita Chakravarty)
April 20, 2020, 11:12pm
4
Graphics[{Table[{Opacity[0.2], RandomColor ,
EdgeForm[
Directive[Opacity[.3], Dashed,
Thickness[RandomReal[{0.05, 0.1}]], RandomColor ]],
Disk[RandomReal[10, 2], RandomReal[{.5, 1.}]]}, {200}]}]
3 Likes
vaungureanu
(Valeriu Ungureanu)
April 21, 2020, 7:31am
7
Hi, Abrita,
I have modified a little your code:
Graphics[Table[{RGBColor[i^2/100, j^2/100, 1 - (i^2 + j^2)/200],
EdgeForm[
Directive[Opacity[.977], Dashed,
Thickness[RandomReal[{0.05, 0.1}]], Opacity[.87],
Hue[(i^2 + j^2)/200]]], Disk[{i, j}, RandomReal[{.5, 1.}]]}, {i,
10}, {j, 10}]]
to obtain the following result:
3 Likes
Stephen Wolfram is a colorful character.
sw = Entity["PopularCurve", "StephenWolframCurve"]["Graphics"];
SeedRandom[314];
sw /. RGBColor[___] :> RandomColor[] /. AbsoluteThickness[1] -> AbsoluteThickness[2] /.
Axes -> False
4 Likes
abritac
(Abrita Chakravarty)
April 21, 2020, 4:05pm
9
Daily challenge (Day 11) : Create a contour plot of a 5 km radius around the nearest mountain peak to wherever you are situated.
nearestMountain = GeoNearest[“Mountain”, Here] // First;
elevationData =
GeoElevationData[nearestMountain,
GeoRange → Quantity[5, “Kilometers”],
UnitSystem → “Metric”];
ListContourPlot[Reverse@elevationData, ColorFunction -> "LightTerrain"]
Turns out that the mountain nearest me has higher elevations within 5 km than the mountain itself.
2 Likes
vaungureanu
(Valeriu Ungureanu)
April 22, 2020, 6:32am
11
elevations =
GeoElevationData[
GeoBoundingBox@
GeoDisk[Entity[“Mountain”, “Moldoveanu”],
Quantity[5, “Kilometers”]], Automatic, “GeoPosition”,
GeoZoomLevel → 10];
GeoContourPlot[elevations, GeoBackground → “ReliefMap”,
ContourShading → True, ColorFunction → Hue,
PlotLegends → Automatic]
2 Likes
pacolombo
(PierAlbino Colombo)
April 22, 2020, 10:50am
12
(A little bit memory intensive but nice )
threeLavaredoPeaks =
GeoElevationData[Entity[“Mountain”, “TreCimeDiLavaredo”],
GeoRange → Quantity[5, “Kilometers”],
GeoProjection → Automatic, GeoZoomLevel → 12] // Reverse;
(Plots. Mouse over contour line will show tooltip with height value )
GraphicsRow[{
GeoContourPlot[
Reverse@GeoElevationData[
GeoBoundingBox[
GeoDisk[Entity[“Mountain”, “TreCimeDiLavaredo”],
Quantity[5, “Kilometers”]]], Automatic, “GeoPosition”,
GeoZoomLevel → 12], GeoBackground → “Satellite”,
ContourStyle → White, ImageSize → 450],
ListContourPlot[threeLavaredoPeaks, ColorFunction → “DarkTerrain”,
ContourLabels → Automatic, ImageSize → 600],
ReliefPlot[threeLavaredoPeaks, ColorFunction → “DarkTerrain”,
ImageSize → 550]
}, Spacings → {10, 0}, ImageSize → 1000]
(*3D plot*)
ListPlot3D[threeLavaredoPeaks, Mesh -> None,
ColorFunction -> "DarkTerrain", ImageSize -> 900]
3 Likes
abritac
(Abrita Chakravarty)
April 22, 2020, 2:52pm
13
Thanks for the amazing contour plots!!!
Remember no study group today but please feel free to check out the second session of our “New in Wolfram Language 12.1 ” webinar series at
abritac
(Abrita Chakravarty)
April 23, 2020, 3:21pm
14
Daily Challenge (Day 12): This one is again from EIWL (Chapter 9).
Make a Manipulate to show a bar chart with 4 bars, each with a height that can be between 0 and 10
pacolombo
(PierAlbino Colombo)
April 23, 2020, 3:58pm
15
Manipulate[
BarChart[{b1, b2, b3, b4}, LabelingFunction → Center,
PlotRange → {All, {0, 10}}],
Row[{
Control[{{b1, 0, “b1”}, 0, 10, 1, Appearance → “Labeled”}],
Control[{{b2, 0, “b2”}, 0, 10, 1, Appearance → “Labeled”}],
Control[{{b3, 0, “b3”}, 0, 10, 1, Appearance → “Labeled”}],
Control[{{b4, 0, “b4”}, 0, 10, 1, Appearance → “Labeled”}]
}],
ControlPlacement → Right, ControlType → VerticalSlider
]
1 Like
Manipulate[
BarChart[{a, b, c, d},
PlotRange → {0, 10},
LabelingFunction → Top,
ChartLabels → Placed[{“a”, “b”, “c”, “d”}, Above],
ColorFunction → “Rainbow”],
{a, 0, 10}, {b, 0, 10}, {c, 0, 10}, {d, 0, 10}]
1 Like
vaungureanu
(Valeriu Ungureanu)
April 23, 2020, 6:37pm
17
Manipulate[
BarChart[{a[1 ], a[[2]], b[1 ], b[[2]]},
ChartLabels → {“!\*SubscriptBox[\(a , 1 ])”,
“!\*SubscriptBox[\(a , 2 ])”,
“!\*SubscriptBox[\(b , 1 ])”,
“!\*SubscriptBox[\(b , 2 ])”}, LabelingFunction → Above,
PlotRange → {-0.5, 10.2}, ChartElementFunction → “GlassRectangle”,
ChartStyle → “Pastel”, PlotTheme → “Business”],
Row[{Control[{{a, {3, 1}}, {0, 0}, {10, 10},
Appearance → “Labeled”}],
Control[{{b, {7, 10}}, {0, 0}, {10, 10},
Appearance → “Labeled”}]}]]
1 Like
abritac
(Abrita Chakravarty)
April 23, 2020, 9:46pm
18
Here’s mine:
Manipulate[
BarChart[{a, b, c, d}, ChartStyle -> "DarkRainbow",
ColorFunction ->
Function[{x},
Directive[ ColorData["DarkRainbow"][x],
EdgeForm[{Thickness[x/100], Dashed, RandomColor[]}]]],
ChartLabels -> {"a", "b", "c", "d"}, PlotRange -> {0, 10},
ImagePadding -> 10], {{a, 2}, Range[0, 10]}, {{b, 4}, Range[0, 10],
ControlType -> SetterBar}, {{c, 6}, 0, 10, 1}, {{d, 8},
Button["Pick a number between 0 and 10",
d = RandomInteger[{0, 10}]] &},
ControlPlacement -> {Top, Top, Bottom, Bottom}]
1 Like
abritac
(Abrita Chakravarty)
April 24, 2020, 5:12pm
19
Daily Challenge (Day 12) : Share with us an interesting piece of data visualization from your work/study/reasearch.
nanto2001
(Andrew Skipor)
April 25, 2020, 2:29am
20
Hello,
I like these elegant BarChart solutions. I’m a beginner and took a more “direct” approach. But then I thought how to bring some uniqueness to the solution. I thought it would be cool to use a speech synthesizer that verbalizes the height of the histogram bars. I found a speech synthesizer but the problem I face is how to take the adjustable bar height numerical value; convert it to text; and have the text inserted into the speech synthesizer. Any suggestions would be very helpful . I’ve attached my bar-chart program.
Thank you very much,
Andrew Skipor
colored barchart.nb (163 KB)