Wolfram Blog » Wolfram Language http://blog.wolfram.com News, views, and ideas from the front lines at Wolfram Research. Fri, 12 Jan 2018 23:30:21 +0000 en hourly 1 http://wordpress.org/?v=3.2.1 Slicing Silhouettes of Jupiter: Processing JunoCam Images http://blog.wolfram.com/2018/01/12/slicing-silhouettes-of-jupiter-processing-junocam-images/ http://blog.wolfram.com/2018/01/12/slicing-silhouettes-of-jupiter-processing-junocam-images/#comments Fri, 12 Jan 2018 15:38:59 +0000 Jesse Dohmann http://blog.internal.wolfram.com/?p=40405 Juno images processing

With the images from the Juno mission being made available to the public, I thought it might be fun to try my hand at some image processing with them. Though my background is not in image processing, the Wolfram Language has some really nice tools that lessen the learning curve, so you can focus on what you want to do vs. how to do it.

The Juno mission arose out of the effort to understand planetary formation. Jupiter, being the most influential planet in our solar system—both literally (in gravitational effect) and figuratively (in the narrative surrounding our cosmic origin)—was the top contender for study. The Juno spacecraft was launched into orbit to send back high-res images of Jupiter’s apparent “surface” of gases back to Earth for study in order to answer some of the questions we have about our corner of the universe.

The images captured by the Juno spacecraft give us a complete photographic map of Jupiter’s surface in the form of color-filtered, surface patch images. Assembling them into a complete color map of the surface requires some geometric and image processing.

Preprocessing the Images

Images from the JunoCam were taken with four different filters: red, green, blue and near-infrared. The first three of these are taken on one spacecraft rotation (about two revolutions per minute), and the near-infrared image is taken on the second rotation. The final image product stitches all the single-filter images together, creating one projected image.

NASA has put together a gallery of images captured through the JunoCam that contains all the pieces used for this procedure, including the raw, unsorted image; the red, green and blue filtered images; and the final projected image.

Let’s first import the specific red, green and blue images:

Input 1

imgBlue =
  Import["~/Desktop/JunoImages/ImageSet/JNCE_2017192_07C00061_V01-\
blue.png"];
imgGreen =
  Import["~/Desktop/JunoImages/ImageSet/JNCE_2017192_07C00061_V01-\
green.png"];
imgRed = Import[
   "~/Desktop/JunoImages/ImageSet/JNCE_2017192_07C00061_V01-red.png"];

Input 2

{imgRed, imgGreen, imgBlue}

To assemble an RGB image from these bands, I use ColorCombine:

Input 3

jup = ColorCombine[{imgRed, imgGreen, imgBlue}] //
  ImageResize[#, Scaled[.25]] &

To clear up some of the fogginess in the image, we need to adjust its contrast, brightness and gamma parameters:

Input 4

jupInit = ImageAdjust[IMAGE,{.14(*contrast*), .3(*brightness*), 2.(*gamma*)}]

You can see that there’s a shadowing effect that wasn’t as prominent to begin with in the initial color-combined image. To prevent the shadowing on the foreground image from disturbing any further analysis, the brightness needs to be uniform throughout the image. I first create a mask that limits the correction to the white area:

Input 5

newMask = Binarize[jupInit, {0.01, 1}]

When I apply this mask, I get:

Input 6

jupBright = BrightnessEqualize[jupInit, Masking -> newMask]

It’s much darker now, so I have to readjust the image. This time, I’m doing it interactively using a Manipulate:

Input 7

stretchImage[image_] := Block[{thumbnail},

   thumbnail = ImageResize[image, Scaled[.7]];
   With[{t = thumbnail},
    Manipulate[
     ImageAdjust[t, {c, b, g}],
     {{c, 0, "Contrast"}, -5.0, 5.0, 0.01},
     {{b, 0, "Brightness"}, -5.0, 5.0, 0.01},
     {{g, 2.0, "Gamma"}, 0.01, 5.0, 0.001},
     ControlPlacement -> {Bottom, Bottom, Bottom}

     ]
    ]];

Input 8

stretchImage[IMAGE]

I use the parameter values I found with the Manipulate to create an adjusted image:

Input 9

jupadj = ImageAdjust[IMAGE,{-.16, 3.14, 1.806}];

Any time an image is captured on camera, it’s always a little bit blurred. The Wolfram Language has a variety of deconvolution algorithms available for immediate use in computations—algorithms that reduce this unintended blur.

Most folks who do image processing, especially on astronomical images, have an intuition for how best to recover an image through deconvolution. Since I don’t, it’s better to do this interactively:

Input 10

deconvolveImage[image_] := Block[{thumbnail},

   thumbnail = ImageResize[image, Scaled[.7]];
   With[{t = thumbnail},
    Manipulate[
     ImageDeconvolve[t, GaussianMatrix[n], Method -> "RichardsonLucy"],
     {{n, 0, "Blur Correction Factor"}, 1, 3.0, 0.1},
     ControlPlacement -> Bottom

     ]
    ]];

Input 11

deconvolveImage[jupadj]

Again, I use the blur correction I found interactively to make an unblurred image:

Input 12

jupUnblur =
  ImageDeconvolve[jupadj, GaussianMatrix[1.7],
   Method -> "RichardsonLucy"];

And as a sanity check, I’ll see how these changes look side by side:

Input 13

table = Transpose@
   {{"Original", jup},
    {"Initial Correction", jupInit},
    {"Uniform Brightness", jupBright},
    {"Better Adjustment", jupadj},
    {"Deconvolved Image", jupUnblur}};
Row[
 MapThread[
  Panel[#2, #1, ImageSize -> Medium] &,
  table]]

Processing the Image

Now that the image has been cleaned up and prepared for use, it can be analyzed in a variety of ways—though it’s not always apparent which way is best. This was a very exploratory process for me, so I tried a lot of methods that didn’t end up working right, like watershed segmentation or image Dilation and Erosion; these are methods that are great for binarized images, but the focus here is enhancing colorized images.

With Jupiter, there is a lot of concentration on the Great Red Spot, so why not highlight this feature of interest?

To start, I need to filter the image in a way that will easily distinguish three different regions: the background, the foreground and the Great Red Spot within the foreground. In order to do this, I apply a MeanShiftFilter:

Input 14

filtered = MeanShiftFilter[jupadj, 1, .5, MaxIterations -> 10]

This is useful because this filter removes the jagged edges of the Great Red Spot. Additionally, this filter preserves edges, making the boundary around the Great Red Spot smoother and easy for a computer to detect.

Using Manipulate once again, I can manually place seed points that indicate the locations of the three regions of the image (you can see how much the filter above helped separate out the regions):

Input 15Input 15Juno images processing

Manipulate[seeds = pts;
 Row[
  {Image[jupadj, ImageSize -> All],
   Image[ImageForestingComponents[jupadj, pts] // Colorize,
    ImageSize -> All],
   Image[ImageForestingComponents[filtered, pts] // Colorize,
    ImageSize -> All]
   }
  ],
  {
  {pts, RandomReal[Min[ImageDimensions[jupadj]], {3, 2}]},
  {0, 0},
  ImageDimensions[jupadj],
  Locator,
  Appearance -> Graphics[{Green, Disk[{0, 0}]},
    ImageSize -> 10],
  LocatorAutoCreate -> {2, 10}
  }
 ]

The values of the seeds at these places are stored within a variable for further use:

Input 16

seeds

Using these seeds, I can do segmentation programmatically:

Input 17

Colorize[label = ImageForestingComponents[filtered, seeds, 2]]

With the regions segmented, I create a mask for the Great Red Spot:

Input 18

mask = Colorize[DeleteBorderComponents[label]]

I apply this mask to the image:

Input 19

ImageApply[{1, 0, 0} &, jupadj, Masking -> mask]

This is great, but looking at it more, I wish I had an approximate numerical boundary for the Great Red Spot region in the image. Luckily, that’s quite straightforward to do in the Wolfram Language.

Our interactive right-click menu helped me navigate the image to find necessary coordinates for creating this numerical boundary:

Coordinates tool 1

It’s a handy UI feature within our notebook front end—intuitively guiding me through finding roughly where the y coordinate within the Great Red Spot is at a minimum:

Coordinates tool 2

As well as where the x coordinate within that same region is at a minimum:

Coordinates tool 3

I also did this for the maximum values for each coordinate. Using these values, I numerically generate ranges of numbers with a step size of .1:

Input 20

x = Range[144, 275, .1];
y = Range[264, 350, .1];

I construct the major and minor axes:

Input 21

xRadius = (Max[x] - Min[x])/2;
yRadius = (Max[y] - Min[y])/2;

And I approximate the center:

Input 22

center = {Min[x] + xRadius, Min[y] + yRadius}

And finally, I create the bounding ellipse:

Input 23

bounds = Graphics[{Thick, Blue,
   RegionBoundary[
    Ellipsoid[center, {xRadius, yRadius}]
    ]}]

This bounding ellipse is applied to the image:

Input 24

HighlightImage[jupadj, bounds]

More Neat Analysis on Jupiter

Aside from performing image processing on external JunoCam images in order to better understand Jupiter, there are a lot of built-in properties for Jupiter (and any other planet in our solar system) already present in the language itself, readily available for computation:

Input 25

\!\(\*
NamespaceBox["LinguisticAssistant",
DynamicModuleBox[{Typeset`query$$ = "Jupiter", Typeset`boxes$$ =
      TemplateBox[{"\"Jupiter\"",
RowBox[{"Entity", "[",
RowBox[{"\"Planet\"", ",", "\"Jupiter\""}], "]"}],
        "\"Entity[\\\"Planet\\\", \\\"Jupiter\\\"]\"", "\"planet\""},
       "Entity"],
      Typeset`allassumptions$$ = {{
       "type" -> "Clash", "word" -> "Jupiter",
        "template" -> "Assuming \"${word}\" is ${desc1}. Use as \
${desc2} instead", "count" -> "3",
        "Values" -> {{
          "name" -> "Planet", "desc" -> "a planet",
           "input" -> "*C.Jupiter-_*Planet-"}, {
          "name" -> "Mythology", "desc" -> "a mythological figure",
           "input" -> "*C.Jupiter-_*Mythology-"}, {
          "name" -> "GivenName", "desc" -> "a given name",
           "input" -> "*C.Jupiter-_*GivenName-"}}}},
      Typeset`assumptions$$ = {}, Typeset`open$$ = {1, 2},
      Typeset`querystate$$ = {
      "Online" -> True, "Allowed" -> True,
       "mparse.jsp" -> 0.926959`6.418605518937624, "Messages" -> {}}},
DynamicBox[ToBoxes[
AlphaIntegration`LinguisticAssistantBoxes["", 4, Automatic,
Dynamic[Typeset`query$$],
Dynamic[Typeset`boxes$$],
Dynamic[Typeset`allassumptions$$],
Dynamic[Typeset`assumptions$$],
Dynamic[Typeset`open$$],
Dynamic[Typeset`querystate$$]], StandardForm],
ImageSizeCache->{149., {7., 17.}},
TrackedSymbols:>{
        Typeset`query$$, Typeset`boxes$$, Typeset`allassumptions$$,
         Typeset`assumptions$$, Typeset`open$$, Typeset`querystate$$}],
DynamicModuleValues:>{},
UndoTrackedVariables:>{Typeset`open$$}],
BaseStyle->{"Deploy"},
DeleteWithContents->True,
Editable->False,
SelectWithContents->True]\)["Properties"] //
 Take[#, 30] &

Included here is a textured equirectangular projection of the surface of Jupiter: perfect for 3D reconstruction!

Input 26

surface =
 Entity["Planet", "Jupiter"][
    EntityProperty["Planet", "CylindricalEquidistantTexture"]] //
   NestList[Sharpen, #, 2] & //
  #[[-1]] &

Using this projection, I can map it to a spherical graphic primitive:

Input 27

sphere[image_] := Block[{plot},

  plot = SphericalPlot3D[1, {theta, 0, Pi}, {phi, 0, 2 Pi},
    Mesh -> None, TextureCoordinateFunction -> ({#5, 1 - #4} &),
    PlotStyle -> Directive[Texture[image]], Lighting -> "Neutral",
    Axes -> False, Boxed -> False, PlotPoints -> 30]
  ]

Input 28Jupiter Juno image post-processing animation

sphere[surface]

Final Thoughts…

I started out knowing next to nothing about image processing, but with very few lines of code I was able to mine and analyze data in a fairly thorough way—even with little intuition to guide me.

The Wolfram Language abstracted away a lot of the tediousness that would’ve come with processing images, and helped me focus on what I wanted to do. Because of this, I’ve found some more interesting things to try, just with this set of data—like assembling the raw images using ImageAssemble, or trying to highlight features of interest by color instead of numerically—and feel much more confident in my ability to extract the kind of information I’m looking for.


If you’d like to work with the code you read here today, you can download this post as a Wolfram Notebook.

]]>
http://blog.wolfram.com/2018/01/12/slicing-silhouettes-of-jupiter-processing-junocam-images/feed/ 0
Goodbye, 2017! It Was a Marvelous Year for Wolfram Research http://blog.wolfram.com/2018/01/04/goodbye-2017-it-was-a-marvelous-year-for-wolfram-research/ http://blog.wolfram.com/2018/01/04/goodbye-2017-it-was-a-marvelous-year-for-wolfram-research/#comments Thu, 04 Jan 2018 15:04:59 +0000 Michael Gammon http://blog.internal.wolfram.com/?p=40346 Release features and logogram analysis

Whew! So much has happened in a year. Consider this number: we added 230 new functions to the Wolfram Language in 2017! The Wolfram Blog traces the path of our company’s technological advancement, so let’s take a look back at 2017 for the blog’s year in review.

Announcing New Products and Features

The year 2017 saw two Wolfram Language releases, a major release of Wolfram SystemModeler, the new Wolfram iOS Player hit the app store, Wolfram|Alpha pumping up its already-unmatched educational value and a host of features and capabilities related to these releases. We’ll start with the Wolfram Language releases.

“The R&D Pipeline Continues: Launching Version 11.1”

Stephen Wolfram says it’s “a minor release that’s not minor.” And if you look at the summary of new features, you’ll see why:

Release features

Stephen continues, “There’s a lot here. One might think that a .1 release, nearly 29 years after Version 1.0, wouldn’t have much new any more. But that’s not how things work with the Wolfram Language, or with our company. Instead, as we’ve built our technology stack and our procedures, rather than progressively slowing down, we’ve been continually accelerating.”

“It’s Another Impressive Release! Launching Version 11.2 Today”

11.2 word cloud

The launch of Wolfram Language 11.2 continues the tradition of significant releases. Stephen says, “We have a very deliberate strategy for our releases. Integer releases (like 11) concentrate on major complete new frameworks that we’ll be building on far into the future. ‘.1’ releases (like 11.2) are intended as snapshots of the latest output from our R&D pipeline—delivering new capabilities large and small as soon as they’re ready.”

“Launching the Wolfram Data Repository: Data Publishing That Really Works”

Wolfram Data Repository

“It’s been one of my goals with the Wolfram Language to build into it as much data as possible—and make all of that data immediately usable and computable.” To this end, Stephen and company have been working on the Wolfram Data Repository, which is now available. Over time, this resource will snowball into a massive trove of computable information. Read more about it in Stephen’s post. But, more importantly, contribute to the Repository with your own data!

“A New Level of Step-by-Step Solutions in Wolfram|Alpha”

Step-by-step solutions

Our post about Wolfram|Alpha Pro upgrades was one of the most popular of the year. And all the web traffic around Wolfram|Alpha’s development of step-by-step solutions is not surprising when you consider that this product is the educational tool for anyone studying (or teaching!) mathematics in high school or early college. Read the post to find out why students and forward-thinking teachers recommend Wolfram|Alpha Pro products.

“Notebooks in Your Pocket—WolframPlayer for iOS Is Now Shipping”

Wolfram Player

John Fultz, Wolfram’s director of user interface technology, announced the release of a highly anticipated product—Wolfram Player for iOS. “The beta is over, and we are now shipping Wolfram Player in the App Store. Wolfram Player for iOS joins Wolfram CDF Player on Windows, Mac and Linux as a free platform for sharing your notebook content with the world.” Now Wolfram Notebooks are the premium data presentation tool for every major platform.

“Announcing SystemModeler 5: Symbolic Parametric Simulation, Modular Reconfigurability and 200 New Built-in Components”

Wolfram SystemModeler features

The Wolfram MathCore and R&D teams announced a major leap for SystemModeler. “As part of the 4.1, 4.2, 4.3 sequence of releases, we completely rebuilt and modernized the core computational kernel of SystemModeler. Now in SystemModeler 5, we’re able to build on this extremely strong framework to add a whole variety of new capabilities.”

Some of the headlines include:

  • Support for continuous media such as fluids and gases, using the latest Modelica libraries
  • Almost 200 additional Modelica components, including Media, PowerConverters and Noise libraries
  • Complete visual redesign of almost 6,000 icons, for consistency and improved readability
  • Support for new GUI workspaces optimized for different levels of development and presentation
  • Almost 500 built-in example models for easy exploration and learning
  • Modular reconfigurability, allowing different parts of models to be easily switched and modified
  • Symbolic parametric simulation: the ability to create a fully computable object representing variations of model parameters
  • Importing and exporting FMI 2 models for broad model interchange and system integration

“Communication in Industry 4.0 with Wolfram SystemModeler and OPC UA”


SystemModeler OPC UA and Industry 4.0

Earlier last year Markus Dahl, applications engineer, announced another advancement within the SystemModeler realm—the integration of OPC Unified Architecture (OPC UA). “Wolfram SystemModeler can be utilized very effectively when combining different Modelica libraries, such as ModelPlug and OPCUA, to either create virtual prototypes of systems or test them in the real world using cheap devices like Arduinos or Raspberry Pis. The tested code for the system can then easily be exported to another system, or used directly in a HIL (hardware-in-the-loop) simulation.”

Case-Use Blogs That Hit Big

In 2017 we had some blog posts that made quite a splash by showing off Wolfram technology. From insights into the science behind movies to timely new views on history, the Wolfram Language provided some highlight moments in public conversations this year. Let’s check out a few…

“Hidden Figures: Modern Approaches to Orbit and Reentry Calculations”

Hidden Figures input

The story of mathematician Katherine Johnson and two of her NASA colleagues, Dorothy Vaughan and Mary Jackson, was in the spotlight at the 2017 Academy Awards, where the film about these women—Hidden Figures—was nominated for three Oscars. Three Wolfram scientists took a look at the math/physics problems the women grappled with, albeit with the luxury of modern computational tools found in the Wolfram Language. Our scientists commented on the crucial nature of Johnson’s work: “Computers were in their early days at this time, so Johnson and her team’s ability to perform complicated navigational orbital mechanics problems without the use of a computer provided an important sanity check against the early computer results.”

“Analyzing and Translating an Alien Language: Arrival, Logograms and the Wolfram Language”

Black and white logogram

Another Best Picture nominee in 2017 was Arrival, a film for which Stephen and Christoper Wolfram served as scientific advisors. Stephen wrote an often-cited blog post about the experience, Quick, How Might the Alien Spacecraft Work?. On the set, Christopher was tasked with analyzing and writing code for a fictional nonlinear visual language. On January 31, he demonstrated the development process he went through in a livecoding event broadcast on LiveEdu.tv. This livecoding session garnered almost 60,000 views.

“Exploring a Boxing Legend’s Career with the Wolfram Language: Ali at 75”

Ali career graphs

Wolfram celebrated the birthday of the late, great Muhammad Ali with a blog post from one of our data scientists, Jofre Espigule-Pons. Using charts and graphs from histograms and network plots, Espigule-Pons examined Ali’s boxing career, his opponent pool and even his poetry. This tribute to the boxing icon was one of the most-loved blog posts of 2017.

“Analyzing Social Networks of Colonial Boston Revolutionaries with the Wolfram Language”

Revolutionary social networks

For the Fourth of July holiday, Swede White, Wolfram’s media and communications specialist, used a variety of functions in the Wolfram Language to analyze the social networks of the revolutionaries who shaped our nation. (Yes, social networks existed before Facebook was a thing!) The data visualizations are enlightening. It turns out that Paul Revere was the right guy to spread the warning: although he never rode through towns shouting, “The British are coming,” he had the most social connections.

“Finding X in Espresso: Adventures in Computational Lexicology”

Espresso poster

So you say there’s no X in espresso. But are you certain? Vitaliy Kaurov, academic director of the Wolfram Science and Innovation Initiatives, examines the history behind this point of contention. This blog post is truly a shining example of what computational analysis can do for fields such as linguistics and lexicology. And it became a social media hit to boot, especially in certain circles of the Reddit world where pop culture debates can be virtually endless.

“How to Win at Risk: Exact Probabilities”


Risk battle graph

Just in time for the holiday board game season, popular Wolfram blogger Jon McLoone, director of technical communication and strategy, breaks down the exact probabilities of winning Risk. There are other Risk win/loss estimators out there, but they are just that—estimations. John uses the Wolfram Language to give exact odds for each battle possibility the game offers. Absolute candy for gamer math enthusiasts!

We had a great year at Wolfram Research, and we wish you a productive and rewarding 2018!

]]>
http://blog.wolfram.com/2018/01/04/goodbye-2017-it-was-a-marvelous-year-for-wolfram-research/feed/ 0
Spikey Bird: Creating a Flappy Bird Mod in the Wolfram Language http://blog.wolfram.com/2017/12/28/spikey-bird-creating-a-flappy-bird-mod-in-the-wolfram-language/ http://blog.wolfram.com/2017/12/28/spikey-bird-creating-a-flappy-bird-mod-in-the-wolfram-language/#comments Thu, 28 Dec 2017 18:18:15 +0000 Kevin Daily http://blog.internal.wolfram.com/?p=40056 Flappy Bird and Spikey Bird

An earlier version of this post appeared on Wolfram Community, where the creation of a game interface earned the author a staff pick from the forum moderators. Be sure to head over to Wolfram Community and check out other innovative uses of the Wolfram Language!

If you like video games and you’re interested in designing them, you should know that the Wolfram Language is great at making dynamic interfaces. I’ve taken a simple game, reproduced it and modded it with ease. Yes, it’s true—interactive games are yet another avenue for creative people to use the versatile Wolfram Language to fulfill their electronic visions.

The game I’m using for this demonstration is Flappy Bird, a well-known mobile game with a simple yet captivating interactive element that has helped many people kill a lot of time. The goal of the game is to navigate a series of pipes, where each successful pass adds a point to your score. The challenge is that the character, the bird, is not so easy to control. Gravity is constantly pulling it down. You “flap” to boost yourself upward by repeatedly tapping the screen, but you must accurately time your flaps to navigate the narrow gaps between pipes.

So follow along and see what kind of graphical gaming mayhem is possible in just a few short lines of code!

Creating Spikey

I’m going to make Spikey Bird by implementing the gameplay features of Flappy Bird. Our character is going to be Spikey:

Input 1

spikey = RemoveBackground[
   ImageCrop[
    Rasterize[Style["\[MathematicaIcon]", FontSize -> 200],
     ImageResolution -> 700]]];
spikey = ImageResize[spikey, ImageDimensions[spikey]/40]

Considering the season, let’s make Spikey festive:

Input 3

santaHat = ImageCrop[RemoveBackground[\!\(\*GraphicsBox[
TagBox[RasterBox[CompressedData["CUSTOMIMAGEDATA"], {{0,
         2338}, {2200, 0}}, {0, 255},ColorFunction->RGBColor],
        BoxForm`ImageTag[
        "Byte", ColorSpace -> "RGB", Interleaving -> True],
        Selectable->False],DefaultBaseStyle->"ImageGraphics",
       ImageSize->{29., Automatic},ImageSizeRaw->{2200, 2338},
       PlotRange->{{0, 2200}, {0, 2338}}]\)]];
spikey = ImageCompose[
  ImagePad[spikey, {{0, 0}, {0, 7}}, RGBColor[1, 1, 1, 0]],
  ImageResize[santaHat, ImageDimensions[santaHat]/46]]

Game Plan

The gameplay is going to make heavy use of Dynamic within a Graphics expression. Going into all details of how Dynamic works is beyond the scope of this blog, but you can learn more about it watching this great video and reading the extensive documentation.

I’m going to purposely put the most dynamic expressions into an infinite loop. Each update to the dynamic expression is going to take only a fraction of a second—the faster, the better.

The rest of this post is organized around the game’s main mechanic elements:

  • Gravity
  • Player input (controls)
  • Creating objects with automatic movement
  • Hit detection
  • Scoring
  • Sprite animations, sounds and other aesthetics

Designing Gravity

Gravity acts to accelerate an object downward. An acceleration is just a change in velocity per time step, and velocity is just a change in position per time step. One method for modeling gravity is to have velocity update before the position updates:

Input 5

SetAttributes[updateSpikeyPosition, HoldFirst];
updateSpikeyPosition[{pos_, vel_}, gravity_, ups_] := (
  vel += gravity/ups/ups;
  pos += vel/ups;
  pos)

The rate that Dynamic can update—the “updates per second,” or UPS for short—is analogous to frames per second in modern video games. This sets a timescale that is included to slow down the apparent movement; two factors are used in acceleration (distance per second per second) and one factor in velocity (position per second).

The use of HoldFirst allows external variables, provided in the first argument, to update their definitions from within the function:

Input 7

posExample = velExample = 10;
data = Table[
   updateSpikeyPosition[{posExample, velExample}, -1, 1], {i, 25}];
ListPlot[data, AxesLabel -> {"Time Step", "Height"},
 PlotMarkers -> {"\[MathematicaIcon]", 20}, PlotStyle -> Red]

This example has the UPS set to 1. For the given parameters, it took 20 time steps to have the position return to 0. In practice, I set the UPS to be about 30, but this depends on the speed of your CPU.

Player Input

A “flap” is modeled by instantly changing the velocity opposite to gravity. Let’s set this action to the keyboard’s Ctrl key. Because this key controls Spikey’s movement, I put it inside Spikey’s movement code. If I put it somewhere else, like within some other Dynamic expression, you might perceive a slight lag when pressing the key.

It would be cheating if repeated flapping was applied by holding down the key. Thus, an instance of Switch is used to track that the key was pressed only once.

Lastly, I don’t want Spikey to leave the game world, so I include upper and lower bounds to its movement. Changes to updateSpikeyPosition are highlighted:

Input 10

SetAttributes[updateSpikeyPosition, HoldFirst];
updateSpikeyPosition[{pos_, vel_, previousKeyState_}, keyState_,
  boost_, gravity_, ups_] := (
  Switch[{previousKeyState, keyState},
   {False, True}, vel = boost; pos += vel/ups; previousKeyState = True,
   {True, False}, previousKeyState = False];
  vel += gravity/ups/ups;
  pos += vel/ups;
  Which[
   pos < 0, vel = pos = 0,
   pos > 14, pos = 14; vel = 0];
  pos)

I can create a set of controls that can modify gameplay even while you play. I separate the controls into different groups, such as the controls that affect Spikey:

Input 12

SetAttributes[playerEffects, HoldAll];
playerEffects[hPos_, kick_] := Panel[
  Grid[{
    {"Flap Speed", LabeledSlider[Dynamic[kick], {-5, 5}]},
    {"Hor. Position", LabeledSlider[Dynamic[hPos], {0, 20}]}},
   Alignment -> Left],
  "Player"]

And a set of controls that affects the whole game environment:

Input 14

SetAttributes[environmentEffects, HoldAll];
environmentEffects[ups_, gravity_, worldEdge_, imageSize_] := Panel[
  Grid[{
    {"UPS Factor", LabeledSlider[Dynamic[ups], {1, 60}]},
    {"Gravity", LabeledSlider[Dynamic[gravity], {-50, 50}]},
    {"Right Edge", LabeledSlider[Dynamic[worldEdge], {10, 20}]},
    {"Image Size", LabeledSlider[Dynamic[imageSize], {100, 500}]}},
   Alignment -> Left],
  "Environment"]

Spikey is not a graphics primitive, so I use Inset in order to insert it into the Graphics expression. The key here is to use at least the four-argument syntax for Inset so you can specify the size in the fourth argument. Otherwise, the inset object’s size does not scale with the image size of the graphics.

Putting the pieces together in an instance of DynamicModule yields our first basic interface and keeps the variables locally scoped. You can play around with different combinations of gameplay factors, even while the disk is in motion:

Input 16

DynamicModule[{vPos = 10, hPos = 3, vel = 0, ups = 30, gravity = -30,
  kick = 2, previousKeyState = False, worldEdge = 10, imageSize = 200},
 Grid[{{
    Graphics[
     Inset[spikey,
      {Dynamic[hPos],
       Dynamic[
        updateSpikeyPosition[{vPos, vel, previousKeyState},
         CurrentValue["ControlKey"], kick, gravity, ups]]},
      Center, 1.2],
     Frame -> True,
     PlotRange -> {{0, Dynamic[worldEdge]}, {0, 14}},
     ImageSize -> Dynamic[imageSize]
     ],
    Grid[{
      {playerEffects[hPos, kick]},
      {environmentEffects[ups, gravity, worldEdge, imageSize]}
      }, Alignment -> {Left, Top}]}}], SaveDefinitions -> True
 ]

Output 16 animation

Obstacle Movement

Obstacles in Spikey Bird consist of pipes, i.e. rectangles. I’m going to use vertices instead of the Rectangle primitive in anticipation of how I’ll implement hit detection:

Input 17

pipeVertices[hPos_, vPos_, pWidth_, pGap_] := {
  {{hPos, 0}, {hPos, vPos}, {pWidth + hPos, vPos}, {pWidth + hPos, 0}},
  {{hPos, vPos + pGap}, {hPos, 14}, {pWidth + hPos,
    14}, {pWidth + hPos, vPos + pGap}}}

The function allows for flexible creation of a pair of obstacles with a fixed size and gap:

Input 18

Manipulate[
 Graphics[Polygon[pipeVertices[hPos, vPos, pWidth, pGap]],
  PlotRange -> {{0, 10}, {0, 14}}, Frame -> True],
 {{hPos, 5, "Horizontal Position"}, 0, 10},
 {{vPos, 5, "Vertical Position"}, 0, 14 - pGap},
 {{pWidth, 1, "Pipe Width"}, 1, 3},
 {{pGap, 1, "Gap Width"}, 1, 4}, SaveDefinitions -> True]

I use pipeVertices for each update in order to also allow the pipe gap and other factors to dynamically change even while the game is active. The horizontal and vertical positions are extracted from the previous instance of the blocks using the Part function, but only the horizontal position is updated.

I won’t create new objects every time they leave the plot range. Instead, I reuse the object but reset its position if it goes offscreen:

Input 19

SetAttributes[updateBlockPairPosition, HoldFirst];
updateBlockPairPosition[{vertices_}, speed_, ups_, pipeWidth_,
  pipeGap_, worldEdge_] := (
  vertices =
   pipeVertices[vertices[[1, 1, 1]] + speed/ups,
    vertices[[-1, -1, -1]] - pipeGap, pipeWidth, pipeGap];
  Which[
   Max[vertices[[All, All, 1]]] < 0 && speed < 0,
   vertices =
    pipeVertices[worldEdge, RandomReal[{2, 11}], pipeWidth, pipeGap],
   Min[vertices[[All, All, 1]]] > worldEdge && speed > 0,
   vertices =
    pipeVertices[-pipeWidth, RandomReal[{2, 11}], pipeWidth, pipeGap]
   ];
  vertices)

Let’s add more gameplay controls for the obstacles:

Input 21

SetAttributes[obstacleEffects, HoldAll];
obstacleEffects[scrollSpeed_, pipeWidth_, pipeGap_] :=
 Panel[
  Grid[{
    {"Scroll Speed", LabeledSlider[Dynamic[scrollSpeed], {-5, 5}]},
    {"Pipe Width", LabeledSlider[Dynamic[pipeWidth], {0.5, 4}]},
    {"Pipe Gap", LabeledSlider[Dynamic[pipeGap], {1, 6}]}},
   Alignment -> Left],
  "Obstacles"]

Let’s also include some fun buttons. One resets the blocks, which is needed if you change the size of the playing area. One inverts gravity. And one pauses the game by temporarily setting all movement variables to zero:

Input 23

SetAttributes[buttonEffects, HoldAll];
buttonEffects[velocity_, kick_, gravity_, scrollSpeed_, obstacle1_,
  obstacle2_, pipeWidth_, pipeGap_, worldEdge_] :=
 DynamicModule[{previousMovement, pauseToggle = False,
   gravityToggle = False},
  Grid[{
    {Button["Pause",
      If[pauseToggle,
       pauseToggle = False; {gravity, scrollSpeed, kick, velocity} =
        previousMovement
       ,
       pauseToggle = True;
       previousMovement = {gravity, scrollSpeed, kick, velocity};
       gravity = scrollSpeed = kick = velocity = 0]],
     Button["Reset Block Spacing",
      If[scrollSpeed < 0,
       obstacle1 =
        pipeVertices[worldEdge, RandomReal[{2, 11}], pipeWidth,
         pipeGap];
       obstacle2 =
        pipeVertices[3/2 worldEdge, RandomReal[{2, 11}], pipeWidth,
         pipeGap];
       ,
       obstacle1 =
        pipeVertices[-pipeWidth, RandomReal[{2, 11}], pipeWidth,
         pipeGap];
       obstacle2 =
        pipeVertices[-worldEdge/2 - pipeWidth, RandomReal[{2, 11}],
         pipeWidth, pipeGap];]],
     Button["Invert Gravity",
      gravity = -gravity; velocity = 0; kick = -kick]}
    }, Alignment -> Left]
  ]

Now I have something that looks like a simplified version of Flappy Bird. First I create two pairs of pipes that are roughly equally spaced along the horizontal direction, but off of the right side of the visible plot range. There’s no hit detection yet, so you can change with the parameters to adjust the difficulty without frustration.

Input 25

DynamicModule[{vPos = 10, hPos = 3, vel = 0, ups = 30, gravity = -50,
  kick = 2, scrollSpeed = -1.6, pipeWidth = 2, pipeGap = 3.25,
  previousKeyState = False, obstacle1, obstacle2, worldEdge = 12,
  imageSize = 200},
 obstacle1 =
  pipeVertices[worldEdge, RandomReal[{2, 11}], pipeWidth, pipeGap];
 obstacle2 =
  pipeVertices[3/2 worldEdge, RandomReal[{2, 11}], pipeWidth, pipeGap];

 Grid[{{
    Framed[Graphics[{
       Inset[
        spikey, {Dynamic[hPos],
         Dynamic[updateSpikeyPosition[{vPos, vel, previousKeyState},
           CurrentValue["ControlKey"], kick, gravity, ups]]}, Center,
        1.2],
       Polygon[
        Dynamic[updateBlockPairPosition[{obstacle1}, scrollSpeed, ups,
           pipeWidth, pipeGap, worldEdge]]],
       Polygon[
        Dynamic[updateBlockPairPosition[{obstacle2}, scrollSpeed, ups,
           pipeWidth, pipeGap, worldEdge]]]
       },
      Frame -> False, PlotRange -> {{0, Dynamic[worldEdge]}, {0, 14}},
       ImageSize -> Dynamic[imageSize]
      ], FrameMargins -> -1],
    Grid[{
      {buttonEffects[vel, kick, gravity, scrollSpeed, obstacle1,
        obstacle2, pipeWidth, pipeGap, worldEdge]},
      {environmentEffects[ups, gravity, worldEdge, imageSize]},
      {playerEffects[hPos, kick]},
      {obstacleEffects[scrollSpeed, pipeWidth, pipeGap]}
      }, Spacings -> {1, 1}, Alignment -> {Left, Top}]}}],
 SaveDefinitions -> True]

Output 25 animation

Hit Detection

There are many ways to implement hit detection. I’ll implement a perimeter of points around each object and track how close Spikey gets to each point. This allows us to use more interesting polygons later with minimal effort.

Let’s add points to our existing polygons. I’ll take a walk around the polygon, so let’s add the starting point to the end of our perimeter:

Input 26

originalPolyPoints = pipeVertices[5, 5, 2, 2][[1]];
cyclic = Append[originalPolyPoints, First[originalPolyPoints]]

Now accumulate the distances between the vertices in the walk around the polygon, including zero at the start:

Input 28

accumulatedDistance =
 Prepend[Accumulate[Norm /@ Differences[cyclic]], 0.]

Linearly interpolate the x and y coordinates. This creates a function for our walk around the perimeter:

Input 29

intX = Interpolation[
   Transpose[{accumulatedDistance, cyclic[[All, 1]]}],
   InterpolationOrder -> 1];
intY = Interpolation[
   Transpose[{accumulatedDistance, cyclic[[All, 2]]}],
   InterpolationOrder -> 1];

Our walk consists of a number of steps with equal spacing. The spacing between the chosen points is small enough that Spikey can’t squeeze through two adjacent points. Before I start the interpolated walk, I join the original vertex distances to the equally spaced ones:

Input 31

spacing = 0.8;
steps = Union[Range[0, Last[accumulatedDistance], spacing],
   Most[accumulatedDistance]];
newPts = Transpose[{intX[steps], intY[steps]}]

I put all of these steps into a function:

Input 34

generatePerimeterPoints[originalPoints_, spacing_] :=
 Module[{cyclic, accumulatedDistance, intX, intY, steps},
  cyclic = Append[originalPoints, First[originalPoints]];
  accumulatedDistance =
   Prepend[Accumulate[Norm /@ Differences[cyclic]], 0.];
  intX = Interpolation[
    Transpose[{accumulatedDistance, cyclic[[All, 1]]}],
    InterpolationOrder -> 1];
  intY = Interpolation[
    Transpose[{accumulatedDistance, cyclic[[All, 2]]}],
    InterpolationOrder -> 1];
  steps =
   Union[Range[0, Last[accumulatedDistance], spacing],
    Most[accumulatedDistance]]; Transpose[{intX[steps], intY[steps]}]
  ]

Spikey hits a pipe if it gets within a minimal distance to any of the points:

Input 35

hit[position_, obstaclePoints_, dist_] :=
 Min[Norm /@ Transpose[Transpose[obstaclePoints] - position]] < dist ||
   position[[2]] > 13.5 || position[[2]] < 0.5

Here's a visualization of this effect in action. A detected hit colors the circle red:

Input 36

DynamicModule[{pos = {1, 1}},
 Grid[{{
    Graphics[{Point[newPts],
      Dynamic[If[hit[pos, newPts, 0.5], Red, Green]], Thick,
      Circle[Dynamic[pos], 0.5]},
     ImageSize -> Small, PlotRange -> {{0, 10}, {-0.1, 6}},
     Frame -> True, Axes -> False, AspectRatio -> Automatic],
    Slider2D[Dynamic[pos], {{0.5, 0.4}, {9, 5.5}}]}}],
 SaveDefinitions -> True
 ]

Output 36 animation

Scoring

Let's reward the player with a point. Every time a pair of blocks passes the player, I add a point to the score. I also set a flag to False to indicate that I should not score a second time until the block resets:

Input 37

SetAttributes[scoreFunction, HoldFirst];
scoreFunction[{score_, scoreFlag_}, hPos_, worldEdge_, speed_,
  obstacle_] := (
  If[scoreFlag &&
    (Max[obstacle[[All, All, 1]]] < hPos && speed < 0 ||
      Min[obstacle[[All, All, 1]]] > hPos && speed > 0),
   score++; scoreFlag = False];
  If[
   Max[obstacle[[All, All, 1]]] < 0 && speed < 0 ||
    Min[obstacle[[All, All, 1]]] > worldEdge && speed > 0,
   scoreFlag = True];
  )

Now let's add the scoring feature and hit detection to our game. The game objects get extra vertices by mapping generatePerimeterPoints over the pipe vertices, but updateBlockPairPosition only outputs the original vertices. This allows easier application of textures.

Scoring is added by including scoreFunction. Changes to updateBlockPairPosition are highlighted:

Input 39

SetAttributes[updateBlockPairPosition, HoldFirst];
updateBlockPairPosition[{vertices_, score_, scoreFlag_}, hPos_,
  speed_, ups_, pipeWidth_, pipeGap_, worldEdge_] :=
 Module[{originalVertices},
  originalVertices =
   pipeVertices[vertices[[1, 1, 1]] + speed/ups,
    vertices[[-1, -1, -1]] - pipeGap, pipeWidth, pipeGap];
  vertices = generatePerimeterPoints[#, 0.5] & /@ originalVertices;
  scoreFunction[{score, scoreFlag}, hPos, worldEdge, speed,
   vertices];
  Which[
   Max[vertices[[All, All, 1]]] < 0 && speed < 0,
   originalVertices =
    pipeVertices[worldEdge, RandomReal[{2, 11}], pipeWidth, pipeGap];
   vertices = generatePerimeterPoints[#, 0.5] & /@ originalVertices;
   ,
   Min[vertices[[All, All, 1]]] > worldEdge && speed > 0,
   originalVertices =
    pipeVertices[-pipeWidth, RandomReal[{2, 11}], pipeWidth,
     pipeGap];
   vertices = generatePerimeterPoints[#, 0.5] & /@ originalVertices;
   ];
  originalVertices]

Let's add a button to reset the game with the current settings so I don't have to reevaluate the function every time:

Input 41

SetAttributes[resetButton, HoldFirst];
resetButton[{score_, velocity_, kick_, gravity_, scrollSpeed_,
   obstacle1_, obstacle2_}, startingValues_, pipeWidth_, pipeGap_,
  worldEdge_] := Button["Reset Game",
  {gravity, velocity, kick, scrollSpeed} = startingValues;
  score = 0;
  If[scrollSpeed < 0,
   obstacle1 =
    pipeVertices[worldEdge, RandomReal[{2, 11}], pipeWidth, pipeGap];
   obstacle2 =
    pipeVertices[3/2 worldEdge, RandomReal[{2, 11}], pipeWidth,
     pipeGap];
   ,
   obstacle1 =
    pipeVertices[-pipeWidth, RandomReal[{2, 11}], pipeWidth,
     pipeGap];
   obstacle2 =
    pipeVertices[-worldEdge/2 - pipeWidth, RandomReal[{2, 11}],
     pipeWidth, pipeGap];]]

Let's add a button to toggle the hit detection so it's only on when I'm ready for it:

Input 43

SetAttributes[hitEffects, HoldAll];
hitEffects[hitToggle_] :=
 Button["Hit Detection",
  If[hitToggle, hitToggle = False, hitToggle = True],
  Appearance -> Dynamic[If[hitToggle, "Pressed", Automatic]]]

Putting It All Together

In addition to the hit detection and scoring, some finishing touches include styling the objects and the background. Changes to the interface are highlighted:

Input 45

DynamicModule[{vPos = 10, hPos = 3, vel = 0, ups = 30, gravity = -50,
  kick = 2, scrollSpeed = -1.6, pipeWidth = 2, pipeGap = 3.25,
  previousKeyState = False, obstacle1, obstacle2, worldEdge = 14.5,
  imageSize = 500, hitToggle = True, score = 0, canScore1 = True,
  canScore2 = True, startingValues},
 obstacle1 =
  generatePerimeterPoints[#, 0.5] & /@
   pipeVertices[worldEdge, RandomReal[{2, 11}], pipeWidth, pipeGap];
 obstacle2 =
  generatePerimeterPoints[#, 0.5] & /@
   pipeVertices[3/2 worldEdge, RandomReal[{2, 11}], pipeWidth,
    pipeGap];
 startingValues = {gravity, vel, kick, scrollSpeed};

 Grid[{{
    Framed[Graphics[{
       Inset[spikey,
        {Dynamic[hPos],
         Dynamic[
          If[hitToggle,

           If[hit[{hPos, vPos},
             Flatten[Join[obstacle1, obstacle2], 1], 0.5],

            If[gravity != 0 || vel != 0 || kick != 0 ||
              scrollSpeed != 0,
             startingValues = {gravity, vel, kick, scrollSpeed}];
            gravity = vel = kick = scrollSpeed = 0]];

          updateSpikeyPosition[{vPos, vel, previousKeyState},
           CurrentValue["ControlKey"], kick, gravity, ups]
          ]}, Center, 1.2],
       {EdgeForm[Black],
        Texture[{{{1, 0, 0}, {1, 1, 1}, {1, 1, 1}}}],
        Polygon[
         Dynamic[updateBlockPairPosition[{obstacle1, score,
            canScore1}, hPos, scrollSpeed, ups, pipeWidth, pipeGap,
           worldEdge]],
         VertexTextureCoordinates ->
          3 {{0, 0}, {1, 1}, {2, 0}, {1, -1}}]},
       {EdgeForm[Black],
        Texture[{{{1, 0, 0}, {1, 1, 1}, {1, 1, 1}}}],
        Polygon[
         Dynamic[updateBlockPairPosition[{obstacle2, score,
            canScore2}, hPos, scrollSpeed, ups, pipeWidth, pipeGap,
           worldEdge]],
         VertexTextureCoordinates ->
          3 {{0, 0}, {1, 1}, {2, 0}, {1, -1}}]},
       Text[Style[Dynamic[score], 30], Scaled[{0.5, 0.8}], Center],

       },
      Frame -> False, PlotRange -> {{0, Dynamic[worldEdge]}, {0, 14}},
       ImageSize -> Dynamic[imageSize], Background -> Darker[Green]
      ], FrameMargins -> -1],
    Grid[{
      {buttonEffects[{vel, kick, gravity, scrollSpeed, obstacle1,
         obstacle2}, pipeWidth, pipeGap, worldEdge]},
      {hitEffects[hitToggle]},
      {resetButton[{score, vel, kick, gravity, scrollSpeed, obstacle1,
          obstacle2}, startingValues, pipeWidth, pipeGap,
        worldEdge]},
      {environmentEffects[ups, gravity, worldEdge, imageSize]},
      {playerEffects[hPos, kick]},
      {obstacleEffects[scrollSpeed, pipeWidth, pipeGap]}},
     Alignment -> Left]}
   }, Spacings -> {1, 1}, Alignment -> {Left, Top}],
 SaveDefinitions -> True
 ]

Output 45 animation

Final Thoughts

With just a couple hundred unique lines of code, I was able to implement Spikey Bird using the Wolfram Language. Not only that, all of the gameplay parameters were left open to change while you play, kind of like not-so-hidden developers' tools. If you got rid of the developers' tools, then the code would be considerably shorter!

Here are some suggestions you can try on your own:

  • Play the game using only the "Invert Gravity" button.
  • Modify the blocks to fall from the top of the screen to the bottom (similar to classic "flight" games).
  • Change the obstacles to randomly generated polygons instead of rectangles, and add more of them!
  • Add sound effects in appropriate places using EmitSound.

Bonus Suggestion 1: Using Sprites Instead of Primitives

I'm not an artist, but the Wolfram Language makes it simple to include bitmap graphics. For example, I can screen capture images from the internet and import them. Like I did with Spikey, it's often sufficient to just use ImageCrop and RemoveBackground, then use Inset to include it in a graphics expression. It's important to keep the image size small, though, or updates to the image can take time to render for each update. The polygons will still be needed for hit detection, but the images sit on top of them:

Input 46

pipe = \!\(\*GraphicsBox[
TagBox[RasterBox[CompressedData["
1:eJzt2PtXVOUex3Hy9EM/nv8gxBS8zMQtHEVrZSUXgWD27LkPCswAQwYyjKio
iAh2EQFL8waoLS075ik1j6aC4qVlUamlxdLQ8oqJdlmVlsinZ++ZYBbiSTh2
qrU+P7zZz3evxcxrDcOe/czgzAJ99qCgoKCiB8QPfcaMxz2ejFnSP8Ug5xe5
c/JdzoR8ryvH5dFl/kOcdN8XFDRKHO8XFbYcD8pZtma2FD4Bldulm5u/d+Ji
52Icu16KuouW7hrabVh6OhWeJg0WtyZg5TkjivdHwLNXg6K92oHVpMX0Aw8j
57Xh0M8aDNerYeo588IhMMwNgVwZDNkReUsenYxn/r1jfOH7n9BLL7300ksv
vfTSSy+99NJLL7300ksvvfTSSy+99NJLL7300ksvvfTSSy+99NJLL7300ksv
vfTSSy+99NJLL7300ksvvfTSSy+99NJLL7300ksvvfTSSy+99NJLL7300ksv
vfTSSy+99NJLL7300ksvvfTSSy+99NJLL7300ksvvfTSSy+99NJLL7300ksv
vfTSSy+99NJLL7300ksvvfTSSy+99NJLL7300ksvvfTSSy+99NJLL7300ksv
vfTSSy+99NJLL7300ksvvfTSSy+99NJLL7300ksvvfTSSy+99NJLL7300ksv
vfTSSy+99NJLL7300ksvvfTSSy+99NJLL7300ksvvfTSSy+99NJLL71/V+87
vbwXLN01XAzwfv7new3CW9HLu1o4f6teeF9u6/GuOCu8zX++9807eS/5vY29
vGJWnmNANQrvfuHd4PeuC1PPqd7Su/R+5/f+JLznLd3VXwjwfkbvPfGe+4t7
twnvt728/urPC+8XwrvH7/1KePdFqLPyHANqj/A29/LuoZdeev9qXoleehXv
B58OylnaMFf1bpVubrrmxIVfqnD0h1KsOmvpru6cDS+dEt7dGlSdSMDyL4V3
b4Q6K88xoHYL7z7hXS+8M4V3bZh6zlzpvz+rCPBu/s9jhYePDfIcaQ3KXfGq
V/Eu3CndfOu6C1dQi89ulaHhsrW7tV/bsexsKoqaR6HmiwSsumTCjEPh6uzd
rxlYzRoUv6dF7hth0M8ORvaGUPWc+YUQGOYPhvz8g5DTI1Tv1G27ozwfnQjK
394U7qyoXi1FPtE1uz61s+5IOlpay7DreBGqD8rd1Rwy4bmmFExdH4Hyd+Ox
6ICEaRsfwbMbIgfe+kgUbIyCc4kW+vxQZFZr1HOmmcNh8IRBnhEK2RRzS9Yl
deUuXzc1f0fzSLt+MuSYiTDEJMKoS4BpbCLMIuVoHJNwW7IuXhS4vjcZRouj
P2VtiPH3iHJM7DRETcBk9/Sd1mQ79I+O65Js0dCbI5Em0vuTzFGQLFEwWKJ7
1tZodVaz3uOEQbb1zMpativFdOpjYm85XEVvW5PSYdLr4HhpGLKWjBB/m5Fw
1IT6qg2FtWoILItCxDwM9pqhMC8a/IdlXBis/o8pa9Pz4v27INh3jSgf0ik9
NhoOp3eLKc6OZz3xWH5exuGrM3HkmzlYcdqIV07LWHnGhLmHxqK4MVI9V30i
CZ5dWhTu0vwh2aqGwlgegmk7NGJPN8J3jSgTlQ7tlB7t8RbMSET9NSs+vVGG
Uzcr1b17XbsVa8Q1ofzDWJQcjPLt58+kiuuPdkB5e637ylYtvAtC1Guze5Pi
Fa/xfOGd18tbnIi6KxYc/bEUrTcWiL2wFauV7xzEHnN+SyxmHYhSz73c9jS8
Yl87kIp6rfvqN69HXJvd//odb4dFfKbNRevPPm+daE27HfM/HNftXdqWql7f
+5vXX+C6r3zeIepnSZ54faXSu/GWq7b6QO/B/807PcD738zK/7OxQvE+LLwj
6f2/enX00nub1/g39h79aQ4+F17lu16lte0OlH80HiWHotV5WVsaipvD+9++
cOHsmX2+8Nty1A6DqfIheBvDkfem8M67k3cSGq7ZcOJ6GU7+XIGVF0xqqy9Z
MOd9nbgn16pz7alkFDSO6HeeplEoFCnrwsaR6nfIfWV+MQT6ecEofFeD3I3D
kVYS7Lt/CHz/xtvhLnwKNWcmYU9HPlp+mIUtV3KxtSMX267moeGkhJXHk9V5
08UMvHIssV8tO5aA8pbxaspc9fGTKP0gFmV9VLAxGnlro1B2eBy8O6NhXzIU
JrGX893v+L2J6V2T3WPgfW8Uqk5OwuZvsnEJi3EZ1Wpfo0ZU659967vtCpao
j/V6RyZev5oh5hocvjETqy5bxP7KgQZxPxXYmg4lG9ZdTUdtWxK8B7VIXzpM
7D0fEveTY+BwTX/bFGeCPC4WDlsssqY8gamuRMzOM9yzStwS3M54NWX25KQg
O2sicrLi7tBE5DrjkDV5AmzmsZCTdJDidJ1p2tGwZ07b7sguajenToE5zdVl
ejoLxpRMGFKm3LnkfiZ+R3lM9XHFLKdkwCTWv5uwmFOdsOidsBpcneYUBzJK
Ftb9ChNPXgY=
"], {{0, 361}, {44, 0}}, {0, 255},
      ColorFunction->RGBColor],BoxForm`ImageTag[
     "Byte", ColorSpace -> "RGB", Interleaving -> True,
      MetaInformation -> Association[
       "Exif" -> Association[
         "Software" -> "Created with the Wolfram Language : \
www.wolfram.com",
          "DateTime" -> DateObject[{2017, 7, 25, 9, 33, 57.},
            "Instant", "Gregorian", -6.]],
        "Comments" -> Association[
         "Software" -> "Created with the Wolfram Language : \
www.wolfram.com",
          "Creation Time" -> DateObject[{2017, 7, 25, 9, 33, 57.},
            "Instant", "Gregorian", -6.]]]],Selectable->False],
    DefaultBaseStyle->"ImageGraphics",ImageSizeRaw->{44, 361},
    PlotRange->{{0, 44}, {0, 361}}]\); city = \!\(\*GraphicsBox[
TagBox[RasterBox[CompressedData["
1:eJztvXmcXMd1HgouopLYT8/x8vvlOY4UP8mOo8SyndgveXl2ItmyZFmOFsuS
Zck/J5a1ccNGgFhIgAABEDt3EvtKggRAEPsymAEGy2w9a+9796zds+8ACYAD
oN756lZ1V9+5t/v2TDdmwLl/fGjMTN9bVV+d89WpqlP3/uaP5vz1Tx+cNWvW
U/+M/vnrf1z0pfnz/3HJd36Jfvju7Kce/dnsn/z4a7MX/ORnP5n/X3/0EP1y
FeGLD8ya9TB9zq1qsmHDho0ZhXk1rlmPlVZMeT1s2LBh417D1j8bNmzMVNj6
Z8OGjZkKW/9s2LAxU2Hrnw0bNmYqbP2zYcPGTIWtfzZs2JipsPXPhg0bMxW2
/tmwYWOmwtY/GzZszFTY+mfDho2ZClv/bNiwMVNh658NGzZmKmz9s2HDxkyF
rX82bNiYqbD1z4YNGzMVtv7ZsGFjpsLWPxs2bMxU2Ppnw0bR8MC86qaH88RD
06DeMwa2/tmwURzMqWya9VhF46zHrlrH4/T9OdOg7jMFtv7ZsFEwPDBPw4Ok
YQ8srXV+6nW/5x9eD3h+JPBPWfCPb9Dna37P1xY5nA/TvR7CfXC/uRqmum0f
S9j6Z8NGYTCb4r0nCbPp/z+nWO5Fj/tbPbejrO+ONfTfjbLkrejN1U2uRx6r
SN8PceRUt+3jClv/bNgoDJbUOn95eb3r15c3OP8N/f/Xt4U8P+sei46RBt4g
jOXAR72E5EfRa6/63H/8TJ3z15fXO/814ddFPDjl7fs4YpL69yDhoTzx4FS3
2cZ9h3xtDLgXc0ZZ1icpTnvwXNL/dvvN6M3Yh5Hr8Q8jN1tvRKBpLF+03Igw
XB/7IPIB7neoxffK4xWND82rbvqkUuZU98nHApPRv3n5oDr9/6lus437C3r7
sWJn96xehPlV2lz1ck/g5AiLsb7b0Tv9mNNOQPt6xXxZXH9nlO53osP33hMV
jbPmV9/b9s0E5KN/87Q12Yeovx+ZU9n00HstvmXO4XBp3UDoXP1gqDQb8B18
90irf9kc7T6PyPtNNQc2phUeUOzioYU1TZ8q7QocaxwiGxoMnbdkZ0Ph0u0h
7588Wdn4EGlGys4KYW/YkyCte2hVk+sXa/pDR6nMMl7uYKi8+UbkJmnXXZrL
ckxE+yTEPe7gftEPw111WvvKwMOV3uAxmh9/SviRPZ+aTH9a1D/syT9RoeFJ
ws+vNM261BM49gGLswEaqwbvZge+g+9epb579Kp2D3k/e7/fhgTW+qVdPH6V
xzufCIyGb48ysqEcNibt7DrZ2bvNvv/10ysNfP/giYpMTMre6H4/I9t/wen+
JWjUkFI24rbJaJ4ZEAsO3Y3x9oOH1hvh20vrnJ947OrU99f9DjP943vv1U0P
0/j5MNnLI8vqnf/ibCKwrawrUEbjcVlJZ6AsdD3cSTH6bbHGezsbum9Hx/Dd
MF1zvlO7B+51NhnYhnujjPkyB3SGjWnzZnCeLI/JNDt7hOKqhze53Z+/0BU4
S/ZRep7sg/5/qfVm5GZvDvvS25lzONRZotnZhVLNZkthb+fI3p5ryN/e8D1R
v/9Q2hk4W9EXdHaNpfYueNnF0D6Bu0oZtxO3Ih9e7gmWU/v2PN/o+ixp/AOW
2iC4zgdzP+a5N2b6h3HyUeRjEn5yuXHWcw2uB0jn7mB9Y4gwTOifwHiHa4bF
PXAv3BP3RhkoC2Wi7Knm5V4CMUo+ObIfpzzZxyvS7fmnSw2ztgW93xxVbAyf
E4mrBoSdqYC99d6O3aG56wM/vZK2tyct5JdgfU+t3+DdWLG0zhKG72p1eMnr
/iH8RWhV1jZIn87HzmZ/zHNv9PqHMYL86sGNbvcX9ka9P98d8f58Z8j76OEW
3zoad25in540CzHf7QmucdxVrv8o8VHk5uFW3zqUgbJQ5iaP+wtztdzPj0WM
M45zLd5DfM25Xt3k+q091PZdEe/PwEE24Dt76XNL0PONBTXOh+fJPNlqPv4X
faxO1b3KIqpTObz6+2Bt7sHX/J6v7tHa9uj2kOfnNDfY1qvNKbid9YxNLK7q
UewsZW9jPL/k5hHYW1jYG2G9y/276Aeqz0OybRn+UMn94ffomp9TzLVV1m8q
9Y/acrPzo+jYZo/7u9h7NtI/pR943sWLHvdX91q0M4EfL29w/tLcHH05HWxs
orY/v8b14OOlFan+nk1jBNZNziT8h7CO0ifG0onEevnEhANivwxlnkv6D/2M
6jD7YxoH8rWtCsQdjbN+fLlh1r6o7zsjd2MpHrIB3xlhURb+IHxrYY3zERk7
AfdirJZ1zwf6esm15NnU/qah0IkRlm57Me1Mb2/99P9rVPaxNt+Rn15u4P2B
+qrzD9T9J2SLJzv8R66RbU6l5ukwRhrMNrjc3/rZFT4XeHA8x7I9jTwf+1J3
4MQotaH/dm47k2v6r/rcf8XXUcW9rMTK08HGrICvNVc5Z/20pCI1Vjzf6PpX
a5yuz17qCdQM3eUc35Q5mkUby8T9URbKvEJlv0B1WEV1kfWaas2aDNSximKM
Byje+5cUc3yabPc3ie9PH2/3rySfHOu2kCdL3/mIvnsr+kH4Gs19vrTW6f70
Opf7M7jfklrnL8xVyppbgLFaP9bS3PHXUNY6i8B3l9U7Pzk3XacHn6ppepj6
9zMb3O7PekbC1QNa26WdFXMdTW9vN8jHx8q6/KeoT1DX30R9qW6/gTrO02Lz
/2u10/Xpi12BU6gnxV23poH2pfSPYudHXyAbeLY+Hafhk8bGh9e63L8h+uDf
0nc+W9Mf1LhWfDoLbqCMA3Hv8yo3KxpcvzY30yYKamOqf1Dd/41VG3umzvmL
edbrwUUO56wNHu+/XllZ9Wl51qaiL7i/Zyx2m2LrKevbLl527HYV1QUafT+v
QWAcni3agD1vmrN+wjUcjmDPKHEreosw1jU2IR9mNJdjuJ5wo3ssNrY95P0m
1nfUMgtVd3kvx0CI7EMrM0llZ0PHLc2HaL75CuqF6x8nDshW/3noeqSP+hnz
yKnWEUb830lqPH5EdRpD3aiO/wfaXDsQegvc0u+ni+5lAPP5XuqPt2O+r0uO
sS9MevdI681or2wXAXtDed+/U9iY1pexsYvdwQNPiDN5hbYxI//IZWOwQ9jj
/pj36z+/Ytn2HwZXmz3u/945Fr8R6nfepP7+zaW1zs81DIbqsLZazHjPgm+P
Yb+/cShU+2yd83NUr19F3ufc+3AvakEN9/ffIPxbasdnVja6vhC8Fv4Qcwu0
VeTITihXrC99/R2shR+I+x572uH8DMUC/zeV95nFDh53TZi3p6rTdYd9UBz3
OddwqE6s/d/tU+pgBNQL+w5nE/7zTzuaPkPXf3YxcbDW5frd5huRUcyxkOM2
1Rqi9AOf97XciFxb63R9gdr8WfLF+kHNH6ZFPQ1wG/56tM2/SnD8OYprPvOq
z/OnpF03dP2Rt531iX6WfVnVHzqzhGyLuOE2trTO+cvzJ+GbVvwjl40hB+n9
Vv/qp2uaUraPs4hmmkE+8hDhN7YGPbP778ZZfNB5J/pBZCzyQeRO8qOJ+2OB
cRd1iX8YueMeCUeXN7g+hZzr+2UujLy1xysaH3zd7/nz2AeRm8TtLcIY8Xyb
4o27gmOJSfEk0XojcofKuB25HrlJPny7vCfwquDrEYv1luvJjzxR2fjgJrf7
z8N0L6rzrahW9zudmfahb0cGxP7Y3Y5bWr2iArEPI4j7CtH2gtqbBOpGdeTt
7Zo+/mCIHlH39psRJjnGJ/lN6m8FsLNUXyY+it4R/fgR+tF/LRxd1ej6hdma
b1rRwJSN5eEfOW1Mtp/wEY2tt+sHQzHSwE/NTee9Y279yGNU5q6w909xvpBw
i/TvLunf3f70mZvp1Nd3MA603YxcW1bveuTx+2w/BOvSNMZ8e1Dj9rbCcVH4
Uu7Pz03VDwbP5TNHmSOfN1Ilnl/idX9b3Pf2ZOxDnudSMQ1syyqX08kfsnF8
915w3Kdwg3zszo8iH65ucv2y1Vzs2YqNFdI/ZPv7eN4T3x+8RnHwI09UpOfD
KBN5T/tjvv+N79B1YyL+k+dtpmNf36WY46Oa/mDF1d5g2XqX6/Pgb7rGgTgb
iDzZ3RHvTyv7gleahkKeXnGW6V5wLMuA31IMeJPqUFnWFTjzTJ0L6+MPG4zR
D9C4+EmyjYffiftWVvWFrhDPl670BK80DIX8PWOFqbu8fhrbmWF9p7oek+D4
XnBzB7Fa7UDQU9EbvPKy1/NnsH3ygU8YzIc+Sbb38OEWP9lYMGVjTrKx3gL5
h3L93cStyEdUTiWVc0WC6nj1MpXpGQ138zKp7lL/prrvcgFxINYf3gy4f4j9
bnA51VpnBGgzclpOd/hPfIhcg6mMdXiuTIx13IyMLa1zPcDzJHSxIMZF5AFj
XLzcEziG/KPBOzF+3mrwPojTbEw9BshWkBu0M+z91o8vN4zLkUHchedgP0o2
5ugPajZ2V7OxgSLGqbIMPQbupr93v+gf6To/A/WG3/29JyobDccYM9yL82VY
76NyPrEj5P36ey2+BY1DoTaKxXne7RRyhrFwrONW5OapDv9mqtdjq5pcvzqn
kp83+yQ+ae7yO0dafXMOt/jme0dDHaLOyPO4PY3X/G1MI2C/EnZzpTdYQrY0
+3W/5w8x18B6Gz5pHvoLb8d9j9LfFgSvhTUbu118G+NnBscU3E59pmLM+0X/
ejWO2cte11/8hMYYilss7zfNnuD5Mqv3x/j2uBjfaJ5+iueNT7PYScbPr/jc
XwN/yIn98aWGWW8GPN/kZ6nuTOycmQ0bErCfD8X5hZ8KG0NOytOOplnNH4b5
XGS62dh9pH93ENMeb/fv2Rr0PL6q0fUrYl3f6GzVA/LcD84uPd/o+uXtIe/j
24LeOQJzs2A2xXBzX/N7/mZBTZP6HgbDfGK854G+h32s79K1C90joXbkMk+3
2Inqg/y1MfBHmjeX2rgAnzRP3y1ygfH3+2q9y8b0As4EIr+a5rhNW4LcxuZv
JZ/aG/UubrkRGe29Pf384j7SPw138AygGJ5v9D3EaUbnHp9U3sOA5yrsj/r+
5/Bd431IPfrS58vGnnY4/xl/3pfJexigs9DgZ+qcvxT/MDw2dHeKubGAPn62
SZ43m9gzLGzYyAbtzOy9PdM4Udxv+od1QJxZeiduqH+I+2Ytr3f92soG12cp
7vtt5LAeafW/kOf5sjHSv8F1LvcfrKh3fZbu9Tncj/TwF6Xu6fTvX0Y+CPf3
TcO4zwC3dW2esvVJGx9b3NX71TSokyHuQ/3jcdaBuO87j15tfHBuddMjc7T3
DT6EHMyFNc5faBgMNXfciiCP/w7hbuLWBMoZw3MmI8gpRh4Jzg/dpfntd5A/
ObdKKxNzYzx7Y2md8/+Mkl7230ntOUw5TzZs2MiN+1X/Djb7/gHPpMD5GZzT
AvAehiW1zl8NXgt/wOeik8xh5Wds7vD7jOE5dHuj3n/AM0tkmQvEuxiW1zt/
hfRvpP/O/ZczZsPGTMb9pn+9yO0lTSK96W8aClW7hkM1zuFQtVN8uodD4eRH
6bMxhcgDlZoWvm5QJv3sGQmFcU7qfjkrYMOGDQ33of5p9c7yzpFinS8ze8/J
QBHLtGHDRvFwv+pfj/JOBB2KmU95z8u0YcNG8XC/6p8NGzZsTBa2/tmwYWOm
wtY/GzZszFTY+mfDho2ZipmqfzK3zwi5zsipZ+Wmuh33jK9JclXM575OVxTC
xqbz2bF7Y2Ox/HwyzzJnqv4lPwqz5K3xSBDabkYtoWMC50ruR3SPRQy5AvDc
cat8TeQ9T/czukxsTOPNGmf4Xs8M4I2/z8uQqxDDWS6rNpbI871tM03/MD50
kl1W9tWx8m4Hu6TgcncNO5toYm/HollxgLAvGmXnElPfnmLbJM6xh657WXlX
TQZXEu+1BNhb0VhOvvYTX64hLYeymM8mni5A3OIccrKLOt4uEy501bF3m8Ps
rSycAfj7weYoa76hxTYfV97AVYJ07mpP7TifvEI+eardZcnG9kWirKwzvxhw
JuofYr9LPQ5Wkqxm55NV7HynhtKuSnastZHtCEazYidhqz/KjrdNfXuKCal/
gWse4gocVae4kng76mfbA7GcfG0LRFnD4MzSv/rBJnZOx1sp4Wyihu0Jh3Pa
2XbC3jDeAfbx178O0j+MFSU6GysjnzzS4rRkY/DJswlb/3IhQfp3hcaa86R/
9f0O5hmsZS6Cb4jGnC4n8UljTTTMqnucrK7XyWoFHIT6PrLpDh/355PtU9+W
YgL+1q/oH8ZiN/Gk4v3mAHERY2fbfZybWoUvcFdDHB4gLrcTX00zRP94+4i3
BuhfoopV9qZtDJ8N/fXcvuCzF5Ke8bz1OVlFl4u0L8Jjmo+7/oGrdqF/ZaR/
TQOZPnkh6eL6dzgezOBJAvydaPWzLf4Yn5Pd1/p3xyImcG/wgucidN8Oswqy
ydLOSuYnfluv1bJmQvt1B/FJXJP+vRsLsdBwHWse1f7WQojT/1uvOVhFt5vG
mtjU659VribKl3h/SPg66R9xVdVbzXmQAG8n2gJsK9nmlS435wYctQg+wV1k
pI4dJC6hkdNG/4rIGYA24nkZzqFGGjcqaYytSdkYPkMj9eydaJiPs/DdFpU3
8ekbqmf7SP/2Tgf9K7KNgavOsRDNd6tJA6tYeCTTJyvJ32A/x1oCnKe44pMx
4ZOlCS978z7Xv66bIdb5QcASum+F87o37KflRpTivijxHGFHWz3svWY3O9vh
YRc6vKyMcDHh4ePIDqF/AbJB+G8jxYi1fQ7mHazjvF/tmnr96xmLsM4PrXHV
+WGQ9ea5hg67dA2DrxjFyUF2uNnFjre6OU8q3o2F+XhxudPNufEN1XGuGoiz
MHEXGq6fVvrXTbG/VRvruhHM//7Es6Nf4+10h5/zdrLNk+ILtlZC2BeJ8PgP
8Qv8GbG0g8Zk5wB8uo55Bhqmhf6BA6t89XwUydsn0barvVFW3h1m77d4aK7r
Jn4yfRK6Bxs7Sp/wxzDFJQ39tRQnOyh+0WKU8x33of7pxo/kB37WPuhh7UM5
QN/htklxs5Vy+DoWxX2+UW1NBdgaiKewxZ8GYhn87i0an4NC/7D2fyZRTTqo
jTlTpn8KV7C19hFvbq4IHcPevGyzR9hmSTLK3gxEue0ZcQVgXrKFfl+edPMx
G/57NolxvJr0r3Z66J/k7a42xlrhDEhc8+VVjra3FmXvxmFf5rzh5230N6CG
9A82VUPad5psrKK7hvSQ9G9wivRP55OJaxZ9cgg+GbIcB6IteHaIcyhKPGg+
uc3EJ7cJG3uvOciifEytYxfIJ2FnmCO3FED/ekSd9CgWz4hfum4GuY5x0P9h
b+3Dntwgrjvpmh7SP7N66wH985P+7QpF+brKSYrzzrT5DHGq1cfjafgu9A/j
TFVvDcV/4/XvXvGGeDfFFcZkium4/lngq4O+1036Z5UrqX/YS4NtQr/OtBtz
dZoALhHHYBxG/FdNXCEGjBjEf7hv9z20s+5boQwbQ5xiycaGNf3LhzOpf+81
a2vyWBsFb6dNeDtFcA408vjPReNGVU8NaxxwaPqni//6DHgrik8qNgZ0jFr0
yWH4ZIh80jpf0D83zTF2kk/up3j4VJu5T8LGyjs9XP/CwidhZ76h2nHxX69J
edn0zyiXsJjP7k/FL4qmZbXFEQX0cw/Zcv/dWM58yAExjkH/AqMa129FwhQ3
16fWqCTUtYVmskFwDcAe4+JnfE/q36l28zILmhvNY+OANg5b0TsdX8lRL+sj
27aaQ6rq35ukWyUdvtQa1TiuBF8xwU+Mc6TxFdPpH/JfzN7DUiz9S8UvFmxM
z1vndZ8lvqSfSP073Kztd1f3uLLzRoiNpHnjnAnu1PgP6zaDOt6K4ZtdNFZY
1bpxPjkCnwyRT1rjCzYt9W97SLfebsJXPItPSv0rSaS5sZIbLfWvmcYYPTDu
IP+yoDY5pmkf4hmr8UsbIdTvZUEF0dEgz4syqrdRGwZ1+ucl+4KtBSlewRoC
uI+KtYXAkPZ7yTX+HxiqTfUP1z+sx7YalwckbxXmvAPGZPDF9S+H/0ofjg9m
chUa8LH4BxFLXOETecoDiv5hvxs2KLkBIgo3GfyNaFwFCVGd/lX34Z0C6XJk
mfDv7gLn+IIzgOufRX+O6ngLD/ktcSbb0KvTv8puF+cN3PgVm4qMpHkMCx5D
w2kby9C/cJR5R7T763lrK5RvCp9EfGyVq1Yjn7wWyumTki+8k0Kvf1hvj6rc
DKe58Zv4ZHg4rX9bRExi6pMGudFS/5CfCiCvF3vub9Hn7rDmAwUbZ+5o6y+Y
j3VYnbsRYgNedigW1vIBUtDqaQTZFtmGS91a3OE30L/qHgffc8ceB+IWrENf
oJ+vdldz24StXu3W9uWdYv0Pe53YI9kTjmbyJsrcQ3WoG9D6d7LzlOR1P1+/
szpOdNI4XNPpZ3tDEbZf5cuIK1FntQ3vxDVbwT55qaJ/sDHkJFzoqmaXCbA/
xCzVPTWG/F3pzlz/A197I5k2Jj8PkV603Sjc+TiMGZi3WbUxGcucbwuxPRm8
mdvYPsXG0K4jNBZ23sKZj0z9g700kd2Ao0riSvozconAJTiF3tX3IR+hms/p
5PwXc0LY677IeN+EjZ3pKJBP0ryV29iIda6gfe9EIpk+acaVzidR99oB7T2L
2GOT+RZBsd6U8jexFuDMwp9brP9hTwn32aOUpfYT+shpkH8v9W831R/YIxHS
1nCxBl64ODuirT/nEWNL/TsQ1WwBeraHI2KK3SGtLbtFGy50mutfpciDbhD+
i/VU5KteUvQP50LwnSad/u3m9dHKS5et2T72ACetf2MifrEQ96n6V0X6h/Vk
1CUbT6k6izZIX4t9YK5/8NGLXP+0uRts0py/TP2TNrY7Va62TgafaC2U/iFe
5vpnXfukT59rDfH1zj0hCzam8AauD8a1mN9I/7BvBo4qFP+9RDYFntxC/7Be
eo6+gzVA/OxW9E/as+qbuP+Jguy/aWt++diY1D+MEztTXFn3SdS9ph/vsTXW
P+lv0D/YVFMO/lT9M/NJ9FGjwf6b1L8ziToOR28D2XkjO92m5ROeL4T+0fVY
r88n7svQP5qXvEP6B1+B9rhJu7BubISm/kZWmkRbatm7cR9fpyuG/m0PxNnb
0QDnrITQ0NfIXFT++y1BPjeejP7BfxPXfXn7sNS/atI/zDexX2bGE+Am1FB/
nyWuTrY3cJsplv7BNt9vdfF+udRVz20M6wjIAXm7QPqHNRVwli9vUv9KKP5D
32Ed3j1ozhv6+Qq1AW052uosiv7J/Q/0CfoGZVX1NHC7LUt4C5J/j/ypfH1S
1b99Ql+Q427GF7hqJJ88n9T05UBUy5cvhv5h3/idmJ+Xg/KaeNlNPNfSLP9A
6l9ZVxUH8q3brzlS64mlSfF+iztZYEH/rK5f5dI/5MZjTVlbJ64V66DpddIo
+dyVnmqKlytpXqWtCeTSv3M6/y0x0L9zBvp3gLgGZ5e6q1h4WPvbidYAL7O2
X9OQ3iy8ZdO/ifiwqn9bdfmiRkB9PYMO4qeSnUs4uK/tzaF/5w30z5y/TP07
0dbIzzPV9tWwtusO1khjhtQ/rNH2Z7MxC2Nwvuv3RvqHvkvv96i2VZexFl/X
X8Nt7CS1yYr+ndP5b7mB/p010b9zSQfnzUV6oOUDu1L5B1n9MgdvPN8sT5/U
6x/mv17SvvF8pbmKkB1c5j5ZxfVpqwX9O6fTv2z8qfp3kGIe+CTKi406+PcP
ifVn56AWk6g+OcDirHnIyesFHG3xs5Pkw+9EQ1xv3olpZ+rOGAC/Rx/UD+bI
T7Kof20GwO+jiv45RL4obOpqt4PV02eE+JBIjw1VlvTPN6jlrAWGtT1MXO8e
0Hw9IvTPq3ynWZn/7g2HOWfvxv2kNX6ufW/TvVEGciDOmfAGnOqIssA1Y96s
6p+eK6xJJ8X8FzbG80UFJ8gvqyCt92INeVhbW4Z+oV04k4r4Ipv+yXV8cOMW
3MC2svGn7n+Ar7eiQeLLR/qg2dgRik93h7QzruDDyM7OCq4udml7C9nGWqv6
Z2RnHYr+nWv3ETe1PN8d42M1cYf1Tmlj4M9BegUbO5FD/2AvWMtHfotXcALu
+PmuAY1T8OYf0nj0DtWm9U/Mf9/mvukjvoi3tgD3Z/77aG7fxJ6TGWdW9M/I
xsBVUIn/EOPFR7ScZPgk1oKjClfgTupVVv0T+x/S34KCG3ya8RcU+x/a/DdO
dUr75HGysePkA/vEPP391vE+ea4zzo4EnTye2a7kHkIvtfzNGI8DjYA+fsOn
ra/xuZ7Y1x53Jsai/vGcAx26CC1DXvau0D+cF+r4wMHHX5wtr+6rztgvh91e
Je2/0GUt/oOttYzWZ+Rv4Gc1/6VZfCc6qnEt9W9nKJbiTc3VtMLbFr/2PIAM
3vLQvw6hdSpX+Ll31MMcXen4r0XExIjH4K9eiu9bRuVZPtiUg7SlkscYufQv
zU19Km8jG388/2UorX8AuNoWSOcBg6ttWbhCnAOu8HwP7Bn2mdmYRf3rGB5v
Y0A38Xa+XcR/pH+IT3E2EmNDOcUTkWFHysbAH860wcZOtjVk1T9tTqJxEtfZ
lBGPMq9D3f+AX0vffNMib9I3sUcyjrM89M/IxsBVdCCtf/Cltuu1NCZoPlnb
X805klzJOdmFruzxH/Z/Y4q/pXKDRs35k/kvcv1vl87GVJ/cYsDXlmAze6nW
RX3m5jjT7mWldK/z4pwOPs8nxKcC5AcfjGvrJReTYdaL3FJd7iTAzx3cieXU
P9ils8fPKpIBVqXDlUQgZQs4Z19B+nOuw0V67qT6uvjZK4lLSTeNyU76G55j
Fcy5/4FYpYHGcuRR4mfEMfjZ2e9IxX/Yf8Lv/IPK/Jf43BcJcc5wZuecwo0Z
b6X8bz4qP8K1oKEvlMnbzZAl/cP420wxcXVngPNVKXjCJ353plWL3WFTV1Kc
uPhaVRn9/4rCV2nCzX//HrVhV479D4zjGNubcLZN5CYgFszGnzr/fSfu53wd
b820sZKO8fYlbQxjONpyKB4hHwuybgMbw7ofniGSTf9kjId5W6XgqlKxMfB2
JB7mWoa49Cpxc0Fwc5zsqVzH29kO8NlE9fLmjP8Q24ETl4xfhrW4G2sGQRE3
I7bBHjDsUZ3/7qIx6SCN4+DtVHvapsw4k7xh7Zc/l6IjMo4z2Jfmk9n1Dz7Z
0O03tLFL5JN7xZ4HygNf8EX4JLhRuQJ3x1u1v+2PhMz3P0T8l/I3YVPZ+AuI
/GfwAc3bHw0Kn/RkcGTmk2VJmrsFHRnrf82j5mtG6trRmXY/19Cy9iAfF9oM
OIRP91nQP8R+Z1pCXK92BGLiHFoa4EiOeVuFvkvIn2UsxsdLwq6QNg5aWf+r
V9ev6OdLXdbX/8rF+l8uzjKeB0BtcZBtqbzJ81bZ9E+uv2D+sVfsPW4z4EuL
tcZzZcaXFs/m3v/FHOaCwfqfMX+69b92sf5HsVMuG5Pn2h3ieRQHYxGe19ih
54RsCn5sRf/AdV23nz+LRjsDmcmZjBMs8SZsbGdQey6TlfW/q+r6lXjWk379
r9Jo/S8h1/+s8wZNQix7ui3EdT/FBfKUPwoLn8ytf8ebNZ/cbsbVBHxye679
3y7hb2L9Lxt/LtP1vyq+7phTx67XM3eynO/rAR5ljp0N0A7sERdS/861afkH
eF4S1q7eJ2ifQQ3NQeV3aeDnIwTE1gcUYC3ASv7Led36fanB/sd5E/2T+6Ey
JzgbeN6mzAeepP7J/IPdfK0xqOMrkOLKCPjOoXgggyvsZeeK/2AbZQb7H+b8
Zerf8bYmPp+s6XPktLHwiLaWXtPj4tpcKP2rJ853BrUzkEcUjlJ2ZmJjEgd1
vGFN08r+x3mD/ctSnf6VmOx/YH8evCGmtsqbzAeerP6dbAnx9uE5F4Y+2ZLF
J5vH+yR4t5L/cl63/5GNP73+SfvD2mBOHbvWwJoSlzL0Tz2TE1UQU34XL5L+
8TN8Yr1J7WtZB/3PEsgPh1/KdmCv6WA89/pfhcn+b7mif5eyxH/pfJDxHOl5
yzgPVgD9k/tvbnGGVK+1ZvzhE/4Gm5Jcnc2x/2EW/1WY7P+W59C/2IgxX/Ln
iFjXKbT+YT6nX28ysikzHrneSxvryr3/YRr/dVuP/1T9s8pbIfWPP98Mz/ex
aGMSMl9KhZX930sm+79m/JnpnzyTlM0n46R/Tp3+xUczz+PINgbFuaZIMfWP
uMGZ8dCwg1CrnHep5fWRPKv1QzsCWfUvwoZuh5lvJDJO/7AveqEzHWuj/eVd
2lgj9Q82iXtjvymX/qHO8lxObEQ5DzasOw9WIP3D+ktjfwPnK1Vmihtj/qS/
melf9HqEDRJfyH3aouifV3BzRYytKKumt8aQv6uCP1P9G5XnwNJn5VT+5FnD
YunfO1Qnz2Ad75fxNpUeewOKzafiXRP9S9wMs85b4XH6h7Wqi+JshzxjCfsq
V89/9Gt2iH1lM/3Duit4k/0bNOhf/XmwQunfxaSb7u3g/W6kB3r+4qPG+gef
4fl/fRE2cifMnEORcfqX8jfBjRl/FwV/sr1m+hfU+6TCn5H+wY7rxHkc6APq
AH1Bf5WLuV5zEfTvLM8/jVPc7OHPQTQ776KeF6qh72TTP9zvPNWv65qHuXp9
fO6DZ1tJ/YuI+8tzmPL5YnJ9X/ItvyPP/47Xv1rz82DQjB7d86AKMv/VzgaU
JGs5X05RZq7zQln1j+4ZGPCyrlFtPNqixONG3JjxJ8clM/2LizV/cHe525g/
/lyoIugf7od1+NLOGh6n+kXOiaNXsynkJ0r/Rf0udevm++P0D/4bYS1UBoCz
muhfuf8blryNjLepiAGP2fQvV/96lOdBFUL/TrRouXPYA4KNVSv+dknoQTb+
zPSvojPAeq67+XqEPh434saMP+mTRvqXOr8qbMo1oOev2lT/MA6dSVbz3Cep
f2XcV6rFMweLp3+HSf+Qq3G1x1q+vCX9G3UzV894/TOa5xtBnVtk0z+jfGCj
8xCF1D/4x3nFP4zyRY34M9U/unfniHuc/mXjxuz32fTP7DyJ5K/Y+leS1DRD
+i/GepTt0PnvuPVOE/1rHkKu1nj9i1i0MYlc+perf4uhf9gHRx1Uf7uQ0oPs
/Jnq3zXSv67x+me29mbElTrfN9M/83zq7Pp3dgr1r9SC/sn14mzrf9uCcXa0
xaeNTQkn369T579WbVLlOpf+WTkPVmj90/tHtvNCMQP9k/nPmE+XdzZwvo40
+3h/IB84m/5l08WJ6F/JNNW/qIH+HW9rFLndIXa1u540r469HdXaq+pfPrxZ
0b9c58GmSv9KBH+xLPqHfeBTbW5Wi+93OFPrEar+5euTufTP+Dyduf7BRvE8
2ipF/+R3iq1/hxD/4X07WdaLeXya0PQP/Y38E+ShyDwe5KYejGs54Yea3WTD
V9nJ9vpx+sfXQUd1a8n6n0fGP//PTP/4fkAinQ/iNNkPKKT+QbvAl/QPrLef
TRivF3vE+06Qv1vamebqLPKfhb+dSeAdjRXEn2ec/hlxY8afFf0z3E8R/BVb
/86R/pUp+oexHjZVo+hfiagf1r5gZ9W95APSxrorKf5rSN3vPH+fYDX/v6p/
UtOMeNPbmPzMpn/Z+rdY+ofcvZJObU1K6l9ZSg8y+YP+tV7T3l0k/VFC6h/y
c+GTx3n+eKb+xXR86X9W+bOif3w/JZHWvzR/xvon+76O+HaL/WDtmfvaex3k
M8qKsf+B9faTbV7WOFDD1z2lxqfzRbW2e/l7tGpYdU8DzylGXvR7pJuHU3CT
zgX5GQ3kKCC/992YmP8q+oexoEa8nysuci2hrfVK/jPKRTwkn/+cbf8D+au4
1if8OSB4w/5AdKQ4+x9VPfWcL78oE+MT6uAy4K886WIl7Tir501xBd6QY8uf
0YF8Wxo33mvxiFxV7TwYbCwguMHasFxbhk+a85dl/3dUO9eEOjWq+dQKf8Xa
/8D9DlCMVttXy5+3LNcq0QaU7RU2j/qhbnX0vdKEh9sZ3huT5s3N9zO1Z4qH
+biN36NPUEaFyH/2ind7NIr8FbQV69cOJccX7QaP4DOb/mkcm/dvoEj7HyUd
LrLhGl5PqQdNSt9J/hrJJyu6G/kZmtNtXsUfNeDMgHamL8DPDYC/HUL/ZP6z
9Def0NVc/OXa/3AKmwqM8w+Hof5JbZXP8ZV62yx+J8ezYuW/nCc7a72W+bxX
WbZ6JqYN8UG3m+dmqu9a2JrKv0znaEKvdiBf1Sj/WR+vJbV13dT40aWNH40W
8l/i+nqOmDwPuYD5L77BRs5X5hm0unH84XdHm4Pa+alATMdVPM2VOG/Fc1WD
2rstU/kvxA3mPRnrdab8Zc9/0duUyp+MtYu1/4s6haluLbqyW3Q238J1uoGf
2dnG8371NqbjTdgYcqIr1PwXo3gtmd7j5PkvCWv5L2b9q/JWaP3DnKdNsTEz
n2zn74fwpM7omftkXPhkLEP/VH/LyH824c9K/su4eir8mcV/WnzlSOmh1Ht5
9ql48V+cx398rBlUxzdN//l5oRF5RrqGlXdqa3o4H4e8mXPtXvLXNPDzyTbt
/BCeh6WP/wqV/yyfB+oe1GJkOSeQ8Z+zKPFfNBX/ga/AUDoGQ5muQZEvO5zm
D2foYW/ITYXNnG0fD5wdwpqBFv/FU/GfzH8uL0D+s4z/UCenEkNI/jD2t9yD
+K9JF/81qPHfkGbztb11fM9sF9nO8VY/P+uotzGcG0UcfYjHf+FU/GeW/3x5
AvnP6fhP17+KfwSUeKig8V/Cxf1NH/819af5cwufPJ9wpTg+J/jR83WM5h+H
mnXxXx75z5ct5D9L/UOcJ8/KZfBnEv+l9n/1639YL08WP//lsNn6nzJe8udv
JLX1Z7l+gO+1jKbfT9sszviDR5zxP22w/ldhdP6tcyL5zznioXuw/idzbszG
S9iQtv8W521oU947K/mKiudH4LzVIbF/ruqfWf6zMX/m+pda/0sanKebwvW/
s7r1P9j72Q4H24t5W1B7X6/+Pccto1rOG56DBn7k+l9FHvnPcr8xW/zXlKN/
1XioGPsfsLGM9T+hByp/pfQdfBc2hudvpJ4ZodgY6sefH5Z6fkSm/hUq/1m/
/jc+niz+/m+nOG+N57gXev+3tDOdfyDXT6Oib3yDdalnCzXwfJ8qdqq9YZz+
YV0BZwkl1xj7UValkv9cxXNVa3LkPxdm/xe2KZ/jaVX/rO4PpvMP4tr7esUz
rfyD2ppIJGNsTecPSf3Ds67wN/SLHPNre2uy8ndP9n/Jtvj7kG+Yv79iovu/
sHecv5X6J9/Xi9gVNibXPWT+Ae6p7n+gDbAbcFTTm+4PtBM8eYU9o70Xu7T3
5hV7/7ebYhLtGbvZ340ykf1f+JnUP/m+3ojgxz+Ufu6akf9K/ZP+Jn09F38t
OfY/JrL/W6j8P/5OgRFzjk3jPwP9058XOm/CH94fUJrM3O8x0z95ZjLXmTH5
nYnk/xk9D9RI/7jNjXiyvu/Dav6fFf1rFb6JPr2isxe9/pmdR4ya8BceuUf5
f6qdZbGvQuof6lUn8of0+fd6/bN6LlHlbaL6Z2n/d9hj+V0f4+K/CeifOl8t
sxC/xBQe9NwY8TfR/L9c+sfXIzozz3+gfy925al/FqHqH9ZR8KwwtX+R316m
nBeC/eE7Jw30T6/3OfXPKNdcPeMwnM4/z6V/sA/8Tj3/UdY1/n1AZvqXC4bn
PxK1nAv1/Edpp+58QI/m6+8Y6J/R8/7N9M/o/IcZf1bOf6BOl9TzM71p/vLS
Pwu85Tz/wcfU9PkFeT7lfHK8/pnl3xvpn9n5DyPe5PnEXOc/jPpX+kcu/bMK
Vf+OkaZd0J3/KO+Sz/5In//AGZFjBvpndf4WU/wt1/kP1Sdznf/A79TzHxp/
xvoXG5HvnKvNOO+HnwE5RhVa/+T+L/Ybg8MO/iw5WTb2PfzKGb4gP//iYBXd
zpzvD8imf3L+2zSQjkmw/5T//LdO9LVWTzk/jIizhgH9+yALoH/q+d/gcHod
Wn8+VPKH38EmsZ6dr/7J87/gBvG13IfKzl/2/V+Vm/QZ0jR/lvZ/J6B/6vlf
2Fg6Vk2fX5X1gy67BurZ21FtTyMf/aswmf/K86vgyaOb/zp6zee/cv/XrH+l
f2Td/8hT/9TzvyGD87+y76RPIk+yvNOlxYx56p9+/ov9HaP5r56/XPsfKjdR
HX9m+mea6zqSX/7LRPSvRJy3NytbAu12CP/IV/98BXr/h+HzX8RzadW6y89C
6x/yXzwDTWLvIrMO43K4CXie6ET1L9vz/wr1/Bf5O6vPf7Gqh0bPf0G+RdzA
xtT6xLm2NfBnsk1E/1oL+vyX2nQdDfpX5a3Q+ofnv7TozgDFRsaf18B38Hxi
qX9yXMlH/4r1/Be9zXGfEPp3IBbgOYl4j5n08cPxECtPesTadwN/lj6A/2Pf
S+pfKelfYpj8iQDewgPIid/PXvHuYK/5drJXFbzm28Vept/vDr3NYoNN4p0C
buojNzsr3j94IBbmz2Y7n/CJPIl6/k4uPJutqb+Jtxf9gZ8PxUOp/XO+hj+s
vdMHvnow/h570buNbfJsZ2td29ga5w62vGEPW9m0m36/g73i2852hyt4fvTV
rib+DhdHTyN/Ft7RFi8vFzli+P++qJ+/f6vtWj21+xx7tmE3e75pF7/vOsJL
3u3sZR+wg232bKU56WnirYHnc2Dui3MDkUnMf9uIo7YhjWPYpae3jr3g3M+e
a9zNNlNbtLI1vCLq8FbsHc4H4pmqHu2dxrAP2DPGaLSlPFnKXnBtZevd21LX
r6P/o12rnLvYkvqdZBfHyWbreVuwBoR50GTzX2QeAsbxar6fot0Pea2IL2Ws
repfbBBcpDk43nyc8w6belVnZwB4qO26SrbpZS3EXWLYxeq7fanzape7Hayq
tyb1DGbsk2GdBTnR/N0wVD+073JXrZa3iz7rbeLv1cF7A/B+kLLkec4Z6gE7
eMG1na2gPoGdbfTspN9vJds5QrzV8P1G9EdwuNbw+X9n+f4qzclIVxr6Knj/
Lqd7rXFp9rvZu53brFn/ws68k5z/cjsTwM87g++zpfW7yD528bJVO3uJ8Lp/
J+n7FW4fF5Mu8skA9VWQP/8GuVZRruVV7BX/HmrHVvI7rQ0bFZ+EL23yHKC6
V/PYDLaD5+hPNv+FP9tnWDsbFiVO32s+Qhxu4/zJNrwa2MnWOV4Vz7HVxrdW
/mxnL9lVMzvR6ud2iGfMIc8dwP9bFP272BFmfdcCrGs0wHqvBbmuPVO3mT1e
+TybU7WaPalgTtUL7DH6/YqGV7gd94wGxXUBVtKmPX98VzjK8wDfaw6J519r
70JA+2pE/c61+fh3cL5Di//C1MYm1n6NNPV6E0t+gOcG72WPVjzPy5xTtYZj
bvVqNpfqMZv+P5s+X/ZWU5uSpH9+1nWjgfQP771r5uVB/+C/h2LI5WwnX/Sy
nhtudrL1GLXleTZP3HMOv5cGlPXo1ZVkB0dZ14ce8qEG0gu8/6B2Uut/yREf
6x4Fx37iOsQC/XVsSe0GNqd6VapsfR02ubeSxjWRbTaRpmAtC2MC4ph2ik38
1BYXK02c5TzMzbhew7zqNeyxiudojNjPktddPA+4vLuOt0XNfzmry/c5ZyH/
2Sz/Rb2fqn+HYlHiIUj2otkZONgR2M8erVzJ2/ukzs6AJ6pWsYpEOeu/Fmad
I+DNz1w9oXT+S6ImY/3e6PybPv+lsZ/ioutk/6ONrPtDN7uQPCPsek2mjXE7
0/rhZd8+donGzuq+WtEfjTx+OZdUnmdE/VnWBR2sY4nryLW7mupfMxvL6N+e
Wm5nmNNPVP8SI15uYxLwzde9O4nHlRn2IYF2L6hZxxp6r7Dkhy7SjDD3kz3h
VvLLNoqVIsSVk2LjGras4UX2ZOXqVDtSXOE+pAcrG17i8+u2a05W2Yu2aGOp
2Xm/i+IZ0UbPf4b+QR/BM/hpIYDTbYoepLiseYH9rHQZ1zXkrUv9w/2gL9A4
qX94HxXgoviumcbAU6RBWOd8O+pgx8jfj9J4fIxwOH6ErQy8xJb6N7Bn/BvH
YQn9flXgZfZe/H3+fe26ozQvred6tjuk6SCeIyv1D+/wxN8w/rZQ2SXtXvGO
7zC3yz1h5FMeY4eb3+M4Aq0Pb6Gy1meUvVRA+3kDW+M5yNa7zlL7j7EjLYfY
sdYS3nacE9PWgxxsa7CExqrTVAa1seV99mZ0N2+DUdu09q1nb0R2Uf3fZwco
Bt0SPEhj9VFqh/bcvHcxPlLda0iDEjr9U8ffNiXWqeq8xI7ENY6PN5+gexxm
ywObs3C8nq0Lvsa5OETYGT7EtoUO0fh7guKUM8Ql2nKEbY/uNb0HsNi3nr0Y
3kp6foS9Q23ZGjrI9kSO8DEdtqidf6vhMXd8RMtxwLl2xHHQP9le9JWR/mXP
p6b4rNsp+tfH3o+fIjs5Rhwc47Ef6qXv30xsYHuiBzhfmo29Tzpazs9m7IsE
+RoJYlnj8/u1PN7Fugl0ci/OUvL3IZ6ncfkQ5xX9u4P405er2hjqtza4hbg/
zHZFDvPrjrYcpXitgpfj42tc9aSxJezN4LvE7WFuu2/H38m7f9E31T2X+dmG
kg4PjeNR8tEg3+u1YmNe0uejcfLHuMYxfHND6E222JTjDWxZYBPbT3Ho+2RL
bwZOUJx4mm0kwMZe9Z3kbXknfpCtDGbXg5WkB+/GwesRin8Oc5+52nWRc+Md
wHm4mvT5txFtvbS2T54zcPD2Yl7zbtwr9uyvUj+9n1MPng1uYgtqV43Tv3T8
FxgX//kHXSzxQQN9J0SxQYLaW8KeIA2fXU26SjHD3No1bEXbRrYquYmtShig
cxNb0bqJzXGs4d/HdYinNnvKyS47yNabqS6t7GhrZFz8V9/nptiugZV1hPh3
8N294Tb6m4c95aB71oh7Vq5hz4TXs9WdJnUQeNq5lseD86gOGBve8O+isYLG
jev1fOzAnHV10ys0VjxPYzrVk+67yLOOrTZrGwFlLvKu49+dW72WuFnF490Q
f4eYk8YHilmp7vU9GGPdqfEZ76HuEvGNROeojw1cD7O3I4fYoxiHHS/wts2r
e4GtbM9eh2WxDYJfLWZAPDKP+JlPmFuj8f60e515P4n7LA1uEG15gY/hS+s2
MU9/JWunOLvtWiOPtzHXl3uXrTzXtY7/DbEJ2ou+wnup9PpXYhL/NQ3UcRur
6/FQ/7ZT/7qp3puozquV/t2Qs38XNK3ldZ9DdX+CYsXnGt4im22j+W+U/ARz
Le39lGr8V9uP9+w2sgDi3S7EgPVsfzTG45rlDXvZk9UUQ1Rr913oysFf1yb2
TIjiOMHfE8TfEuLPS+MHYqMW4i1Bc5X9kQMUaz/P7WUi/TuXz3FW07hdwjo/
cLKyBM45trKz7VGyITefZ0j966Q5hJGN1XRe5naR8iECyshm6ys7NrH5dZpN
zq3W5gwAbAy2Bt7RlhVtm8x5Smp6wG27WvK0ip1tO8njtpZrDdzWWsie1LN3
/Kwk/a3jOs2xEhhj22gsCNL8pI6daL/EFjqInxx6sLpzM2ngav6eqZ2E2l5t
Lf1Kl4vsNsjKRZ4s1vwwFz7WQvFloox+f4bGxHI+f1zrOcwWkx0scW/gWOoh
Paf2Pt9hjpXU3iWeDalrFpMfrvO8z171VrFXvFdJC69SXFnJ9Qf74qcp1kQ8
WJK4xC51nqa/XaRYpoJ/9xVfFc0FStnTtdDydWyxk+7p2sCei23MWgfgmQCV
7dLqsNC5jr0U3EZcnmNlybPsIqEkcYqt9r1KOrleqyd991my51z3XRbaqNWD
rnmauHne+zKNUafILs9RzHyZt+9sWyNz9vqZr09ba8a66ZXkBXYlkcZl4rqy
s5zG8j1km6RXDVrblnpzc7yieZPCr4aF9etpnFhPPGmfS9zr2fOJLPehvy2P
btI4IixyrWfPeV5kp9tPED/niKuz1KYzrKHviniPWT1z9DhZdXc990XMr9He
Fz0V7L2WSr5+WC2ej+QT639VSj51Pf1N29sr5zZ2tKWU+riKbfaWsmfcL/L6
8jbl3b/UH661bKUH68+V7HX/JfZW/DQ72HKG5jNVYv1Pe0fy5e7L7GLnWYrJ
zlL8fppi9zMUC1ymelTQPG4b8baWLWoUthDIYQsm/J0S/IG7S50lbEtkN9nf
2lTbeP+2G9xP+d1z6F9x38Uc69m7zYfZ5c5z3D82uq+yAzQ3a+yheX+vl7UO
eQgu0rlL3K4ybCxZTvH1UbaQ7AKQ9X0unp1j1PEZryxfs7GniRtuYwJPk82t
aN2Y1c4y9MCl+cxb8QPsEtnQBfLDUuKpsruM6wHWCN0DDo6rXReIxzPUzovk
U5UUN14kDk5TrP0+W1SXWw9WJTeTjaymMbGZ4s5m1tinrYtDV4G4spfZQmMi
YphVTa9yXUfb5leR7nnXcy3NZYu57GSxh+5Xs4775hzSbKwpx0cbOBBfQP9f
8+3geo6yn6LvquDXOtax54hrOWZl9W09F/TdZZGN7Knq9D1xP4xNGKNy6YQK
o/FtQZ24L3ijcelFbznNqdpZKcXRA9eD3C4X6Nok2/UU1WM+1Wsx+f8qtW15
8g7/m1edeb/nc7VNaSPKhu4urBf8iL7CnC5JcUdNj5vtCbXxeO1px4v0nbW8
rxBf74seZxe76/jzVFpkn4r+Te23kr21U1y0P/oOX5/h/Uz1RHm59N56/67l
dZ9HdVtcu5E09zKP9bGfiXjjROtxHoMsENzP1/UFeHsmmI498+qHhObraM98
YWf4fFbcL+d9zGxMYBGN0/y+nPNVbGXjAYprWthBil/bhv1c/9Y6X9f8V98u
h/b/hXXgemOmnVnlmK55lsb++YoP4X6YD3I7s9hPuA/0UNWDl0kPmrmtUJzQ
jXwhB82zd/C2PKXogdpnufRA6t+b/kaOsmQFjeXlFAde4nAOVHC7gO7BTqq6
L7BV7lfYUw1rSefX83gCY2xh9C/dXtjfBveWVD2Aut7L7CX/Nja/AXHQemNQ
nZaTzq9oITRrWNmaO06QvONas/tl8z+1PD2eo7/x+zZp91zIsZZt9J5mr/tc
NO7WMj/FHufaz/DyzNqG6zDWZJRF/3/eKE4wAa5Hny1s1N2vJTdHGOtXiLZo
cWS6r/ZH3qU46go711HBtvhdFJNfZUsaX6R6r+N1X0Dt3U5z+GPtF9n55EVW
z/tT61fYFfLGtPXEKzyW3BHZx+bXv0BxltZ26HYh9E/t34VUt6VNG3msjzId
PeVU/lWKHw5q9p2lH6B/iGky+sFiPdAO6NS4+6EfWrPYWOsmUxuTQAyxUNx3
QcMattK1l2LdJrY7VM8aKK5u6K5gazyvmbYP1y5qMvAhi9zLMYbbmMH9DGNa
A1+CzyxyjdcD2EwN4WT7BXa07QJ7wbM11ZaFBm3JpQdS/xY6NnEsrtvIgTUK
aOf20D4+NsJGsYezuB730ub9vC0Sk9E+nf7Br7hvYX7G67IxVa/nomlfNALW
GdBmfn2ddp8lvjzjU6VdK+X9qF7LwgY6n9DsElwv4HpgAPr9wsZ1fNxX+Vrq
AcebeJy+hObuz7gzy86oh7gGtpVRDrURtmK5fQpX8n7g6OnG7PGV1A5Zruwj
iadr16f6ibepYVOqvbw83l7yC4e0Lw1P19I8r+kV5iTdwdj+RmAXW0hcLw9p
3KbaXggbU3Q8BWozNBBxIGwbn8t8G8fbgY63pb4NWnxRp/VvLv6y2dgqcT/E
TEs8JusR8A/vBjHmmGN5dCO/n6zLsojm11gbgk8vFf6rr0OqnfT751oy7Rll
Qp9XWYzfMvjieqbdD/fh9cs2D25P+68e0AOpA4tqYTvGeqD2WVY9aE/rH9Y0
gPkC+N6T1RQXBnazVpp31vaW83Ln167V+JtsvGdB//gcTakTYIm/Bm0e/VSt
FgdPZn6eul91Dv2rF/G3Qb/xOUCDzj9S8/21nFPMxZ52rstal9T8TR0javPU
P4P7zTeqn4n+GbZP31fUFuP2buDtTNvYWr6m+WzDZtbYp+WQITcM+TiYQ1n2
t0kA/Yu6zlP6IZe94G9Sr2Bjhv2bZz/gfvOqcuifgX/okfKPdtVeFM65/2ax
FwN7Rpl56Z/J/XCfvPw3m40VQg8U/XsuvklgowDZO8WKq8Iv8VzLde43+Loo
NLTo+ifqifliuj4arNjYc1Tv5fIa+j/6DvdaJIB14hUWbXWc/iU1m+LzVHlP
uh/6AWXp6wugLsvo73zO05QG9lGwhi25T43L2erTtinz3qRJWMOTdUG90F4r
/ZNV/+CTAdFOUW/4plH7xkNbm9fHbGif0fdXxjazDd432Says2fqN3P9fHai
/pbDxvj8tzHdB+iTZbq+s9IP8GnVxmT/LlLsDDZhtR+k/vH13YTGlbQXeT/N
Xsx5R32wZqba2BJvpo1xvnPF0u2bMstp3shzV8Abrwt9op6W9N5M/9rH98ci
XX/Ar54qsh5gz2ZuxUrjPXasZUY2aLkTNP/W5uLp/QD5PbPxKlteQsY1Yr2T
xwdibR6f4GLcdRbtXM0TQCwB24KGAbwNbRbiC1FeSv+IizVddL/gRl4/uRau
3s+wvZ3aXFDuOXBUaXq6OhePJv6i8gHb4u3Dmr6IIVZb2NMYp39qvoXSH1gX
x31hM9n61LR/s9mE2E+ZR3EJ7IzHw7r9hYnaWIa9CHvm7VVsAf6lro9b7gdd
G1Zk6d9c+2b4jqp/q0V+2ILatI0Z2YueRwA+o9oCNERvl/naGK8f6ei8SlGf
Km0uubLdAld6/YsJP+lQ+kPxJfQH1lWRN3Qv9AD7Jo+XrTAf51q0XI5l4Y3s
2bCW+7GE+orvVWPfmz7xe/UavqYiv2MCjCdyro7/Y98c+yi8DFEOHz+ttC8H
0AbcT723rDvGAyMe0WdoJ74j1w3AP34HHZjP13y0MRl2aTgOJbTxFm1Defo6
5LNmbgribznZkLw36sJzPsBnMHtuhjqfRhsXq31E9cUeyXzRbtyb90eB1+K4
vYg2pGwMbfBr3KMeGfaiXPdseGNmnQ0g+xe8gBPcJ9UH4Sx9l28b2jbx8VG9
t7TrZ43WTQTQR2iDXGPGOMRtk66Ta3roT9TTzF6kv8k+X6b6kIUcISuAHRv5
EMD3di3Op6HHsk/xCduCb2E/HDG/6pv3Qg8Qay5sXJXTT1S9XVC3no8F0OS5
lev4OpY6VmNuiT0b/p0qA1Rq/ibXfpEfhN8ZjW8F8TGDeIO3oVqJx3XxGh/P
xRiqjk/yZz62OkW7O9PxsJG+oJwF9etSazL5xnu5kDFWd4nxjfjEvDXrd9Xx
V8QYaj/JdmK9BHFvRsxfiH4xq1enFm/MrdBsLMNelD5aRP4+18zGBGDf4AT6
gPshNp5IPJRvG2T+RqrMhMF3CBhL0YZxNpaKT7S5hcq/fu6k5VYJe45tvDc+
JONdh8H6s4m/STvT2xjaCv3j/CTvrR7I/Ger1/J8R9Jp2FMKAW3cUYGxzxQ+
7ZN/N7AhlUvG19dQThFiDL296Ncj8PmM2o6Arr6+dL3V//NrlOtSY7Sy/gwb
mcz6eF4+KPOvxFir/ztilHHtVNum7ye1f8Unxs5itwX9gTggg2sjGzOqtwJe
59CGVF4cz3dUbayIdgb9k+MHjwtaNpm3QW9jyu/1/aWP6VL2bGF/tWA+1CLy
WdX8AzEf5mtsgSztNLIxxZcW3EM9kPsf+frYKhH3rOnW/I2PYWLcQszO8ydl
XKSHuh5WlR73Jroelnff6dYjEG/IsZrXRY03jOqf1GIUXCvbLAH7W61b35Dx
373Uv9Tajz7ecIp4o0aL3fl3zPopmY4n9f2rX+8seDtEHMjr1qXFECl7qdL6
aJk8/2ZSdx5LKO2dp8sfL1bdpZ2p+sftJWpiL1nagHstrMvss8VifVedby3U
z2eKaWdC/1LxX6ti8533lx7krX+6vaEVfD8lc0+N769myeME8PeM/VCxlrYi
Yx+uMPP9cX2nrEc8K2I2jEGpNljY30Jfo47qXhvf0w1vTLUBn7CFhfnsl022
P0XMiXwrvr6p2y/j+c9iTxefGHct3U/Xv8tjmXuRVvfTrQJ9pO4/Ltfvnzeu
T+W6ZbsP1mvV9qL9+r1NKzm5E7Ezfn5B7GnAxuDPentBHbK1AXXjZzMF/wsJ
S33rM/wE4zByhcEJv9+90D/4r2jDsmjaFrjN30d6kJf+JWS+VOa+NGxqQtrc
nnlvff4L+JjIGa+sSCr6V63LbypAOYinUm1wKPOte42Ecb5eIeKDguaHGdqk
SX5dDh/KZWPaPohJ/mShc23E/vl8xcYWGazH5s1NQss/UPPjsH60wuIZp0JD
PR9wP+rBqk7r+ocxHrYPfeZ57/Wa/SzN93yFERLaWM33vOrFfqTI0ytY3CTy
wZEPhT7jbajT2oCxphA+gLmJvC/6bHGu5wsUCat0+ifrxPMPJlOfRDqnPsVf
naZ/6vmIiWJlW3o/M2ULtci9Kcz5X+i/Wm9ox3KRR1aoOFC2AeuXqp8UYizk
6xvhdBsy9G8K7EzNL74f9WBlx2YqJ4f+yTmjOFPHY9HWNApVn5VcX+U9tZxS
7BtBbyfbv9z24+n7IV7PaENBbV9bu8+az19kpPSvRvMP2WcFa2drZl/x82AO
bW42mfaCL+QOcD1tU/qnQPENPxOl9DvmVJjHoUzsDU3Wb3F/xCm4n7ZPVAQ/
addsTOYuTQv9E89wQL3uGz3AOfbGDWz25ZXZvy/3e2rT+c+pZ4YUmnOZi5IU
/ltdmP5N6UHqWSIbM5/ZUsA2yPnbdNK/ldlytCbRT7KveHsrJ99ejPFYM8Oe
7arOTcXpI+WeOJ+a9XxjnjA6L1QsG8N4Pp30j48fRTizUzQ9gJ7SOPXkRfP8
5xTa0+vRRVkvNuJWOetViP3vQt8vGzBeyOdO3AuuzNq7/F61t7Uw7ZXPl5nQ
Wt9E0J4+H1WouKXQ95sO/ZuzvbF7095C6wH8dLEre/6zRFHzBe5RmfesDcXM
4fk4t3cKeLtvbewelzUd6lDosvLNf7Zhw4aNjwsmkv9sw4YNGx8H2Ppnw4aN
mQpb/2zYsDFTYeufDRs2Zips/bNhw8ZMha1/NmzYmKmw9c+GDRszFbb+2bBh
Y6bC1j8bNmzMVNj6Z8OGjZmKlP7h+SA2bNiwMYOAZ28/41vFVve9ZMOGDRsz
CmsGXmbL4mvZ4rJnbdiwYWNGYcmFZ9lTJxexb//hV2zYsGFj5uGPvsJ+/I1v
2LBhw8aMRLBvjQ0bNmzMSCTYBlMk2casML8u9/XZyp1M2VauTU6i7ETOsovX
7slxlr3Oxe6v7OVPpq9z17sYZds2/vGw8fV1XxyHDfVfYutq/wd73fdX7HDP
P7HDvWkc6vkR/3wz8A3+HaPr19d/kW1s+FP2Vsffs/d6f5y+nu71Xt+P2b62
H/AyspW9LfztcdeibOBVz9fMyya86PwKe7fzf9N16vU/4mXvav6u6XWyTrua
v8e/q5aNz3e6/hfd+88Ny95Qp9X7Ve/XUhylOdPavTX0LdN6o2xgX/sPxrUb
7Xgr8fec02ycoU8y2qz01+u+r2flbHPjl9mB5D/oONPqvaf1+1k5w313RL9j
0F//xA52/yN72f1V+q5R2RrfL7u+yr9nxBnuu87w2nR/7Wn5vnF/UXs2Nf2Z
beO2jZva+OyLn8/AHMKTZf+ePVryW2xpzX9h25J/m4EdXX/HdvX8kK1o/BP2
ROnvjLt29oXPs8dLf5t/vhz7Btve+f3Utfj/7t6/57+fW/4fspa9sum/0/f/
Ln2tKHtn9w/YM47/hz1RZlT2v2ePn/9tNv/yF9gbbd/JKHuHKHtD8Ku8DH3Z
AO6J69f6v8zLUuuNNm9JfJctrPiDcdfzelPZj1G9F1f9Idua+N44zlD2KtcX
Ter9ec7lE6X/jm2OfJ3qqi/779lrrd9m8y79RxPOPs85W1b/3zLarPYX/mba
X9TmuRf/I3ut+VuG/bU58peGfM3mZf8Ob/dq95d09f5b6qsfUr99ny2q+s+G
nGn99Vts4dXfZ1s6vmvI2Vrfl3kZ48oWnKHu6FOj/nqz/TvsqSu/Z9xfto3b
Nk5YcPn3MvBU+e+ylQ1/wjaH/pK9Sn24i+opsTP5d2y978/Z6qb/wZZW/xF7
6tIXMq+lnxdX/iHbFPgL9iJdv63je3TdD/i1u7t+yF6h++HaFfV/PK5cef0a
15d42a9TPeW1u7p+wLbTvV5w/ylbRdcvrvzPbMElfb2/wJ6p/i9sc/Br7KUw
8Ut+p16P+qDs5bX/77hrJdZ5v0zX/yV7s/U7VF95LdlE29/wej1P/vD01T8w
KPt32XN1/x8v4+Xo/2Q7Fc6ADf6v8LKfJV8z4mzR1f/ENvq/ytu9tf27GZy9
Hv8mXftF6pM/Zgsv/75hf4ETXPta7JsZbd6R+D5b5/kyL3sJ2ey4somzJVV/
xDlD3Xck/jaj7Jcjf8Wvfa7uvxnyBaz1/Bm/9o2Wv2a7lbLRjheIs1Xk44sq
/pMhZ+gLXPsSlQPbUjnbFPwLXvYyx3816K8vsIVXfp9t8H2F9xf6R/YX6v1G
y7fZGucXtf66Ytxfto3bNg78/zWwbBA=
"], {{0, 131}, {320, 0}}, {0, 255},
      ColorFunction->RGBColor],BoxForm`ImageTag[
     "Byte", ColorSpace -> "RGB", Interleaving -> True,
      MetaInformation -> Association[
       "Exif" -> Association[
         "Software" -> "Created with the Wolfram Language : \
www.wolfram.com",
          "DateTime" -> DateObject[{2017, 7, 25, 9, 37, 51.},
            "Instant", "Gregorian", -6.]],
        "Comments" -> Association[
         "Software" -> "Created with the Wolfram Language : \
www.wolfram.com",
          "Creation Time" -> DateObject[{2017, 7, 25, 9, 37, 51.},
            "Instant", "Gregorian", -6.]]]],Selectable->False],
    DefaultBaseStyle->"ImageGraphics",ImageSizeRaw->{320, 131},
    PlotRange->{{0, 320}, {0, 131}}]\); ground = \!\(\*GraphicsBox[
TagBox[RasterBox[CompressedData["
1:eJzt2HdcFFfbN3BrLDFqTGJJ0UDUSJkBsWEXBMWKipRZTEw0xhAVZWcBFZSi
rChgxcos1mgUY+9lZ5e2YEERUOyKMMNib2hU8L1YyP3oHYnG+Mfz5P39cX8/
m3WZ+c11rnPOnNts1MRhP1arUqUKX5sY9n2gg1L5/RS3D+k/3H15n7G+Y37o
56saM3aMsm3Hn6rTt/H0v/lVq1Qp+3zs260jd3lACCGEEMJ3ZYGbRYfbzhBC
CCGE8F1pGFqrg0sfCCGEEEL4rny8+tLq9eP+2uLVF1avHfdg9dnVq9+B5Vd7
k/v+2Uf0t+veWZKHq8+vXmO68i9vkeTiO01yzpTk4lsm+cV0hXeVZHXFNf/v
Jikf0/LxfRdj9EeSdW/Zt8XvLMkfM+ifJPnfMZexqmBVQbegW95tt/zvSVI+
po/k589PRb9o8X99zow+RW6NTiBnR28iI/+B6uhkck30PfKE6S5ZL93xr5Jk
RZ8m90RvIaNMV5v1j5IkkkL0bTIj+vFfJnkxT9kvs6Mvk4dMSaKjN/6DJBtN
SQ6Sy6JvkekV13/zJPmkPnonOb8iScJbJ5kVvYeMjZbJxL+ZJCu6iEyN3k8u
jf7V9FxvPzqzoreRMaY6H/4bSco76gZ5NFprGt9/MjrlbifnRJ8n95mun1Nx
r9f3bVb0fVOfJ5GrK2rydqNT7mZTkhxyR/TvL9TkTZI8lMvm8hFyQ0XX/ZOa
lK8GGeSmilXi781lrCpYVd5kLqNb0C3/l/egbtKaki0v2V1aW7LV9Pm3aAdp
fcmu6MtSz9KhMTHy6dKSmLmyofQ5mV5aavL5Gxkjp5Y+i1kg55bWmdtC/rl0
VsxgaVeJNrqLtLJkc3SP/9zxv5P84dbontK6koToDKlVqW3MNMpwl652pLTq
3Ji/keSIKUkyJVkoX6MkX8szS9fGjJTEEn10J0lD1+9Bd6k8SVnObdHtpdUl
66M3SPVLP4wJkQ+VFlGSo6XVKEna36yJgeq5SM4ufW+uk7y8dFfMKElbkhvd
kZJsqLhXZUl6ViTRUJK50q2Sp9E/yXtKL8Qslo+X1pwbTUlK3iJJZmmNud/Q
dY7EhEl5JY+jO0hxJb+aalJ5kvKx6yzFl2yKDpDOlhijXeX1pWLMEvkUPVf5
ld88yVxTDefJGVTPAFksLYxZLz0v+SCmAz3prxX36v6nJN1eSGJv6ihf6XjJ
iejO8pzS9RXPVZbk74zOXNPv58snSqtQkuzS4ph90selLWPKnnStaY5se02S
LtIq6qjB1F3a6Jayf2l0zHL5JHVd2eg8+1tJ0k1JDJQkgpI8jjlJs8Ahpp20
jGrS09SxlSUpn8tdqWN/i3aWfqO5XE1WlPIxsXJOaa23GJ3yuZZKn+fJ5+hv
70vDSsfE9KIMeytWjO6VzmWsKlhVXr+qoFvQLf+mPahtxqHim0Evap2xt1gO
ssrYU5wX1C3DUFwv2Drt6p3h/gf0HYq6++bqqxSpfE/r6xX5+mbqaxT99Bpz
9HWLxvle0dcvCvVdQ39bzfdI6ne35/H3j88u3hhkn6ErLg6yyNhVnB/05yRs
xv5iY9BXGZuKzwd9k/Gw+OvgtenFd2cGmCeqilb5puiLjaN9z+kbFPm9UZIs
fe0iH98C/cdFkb5z9dnGggkxKU63OinVx82KzYMGZuQUfxDcKmNb8aVXJLHN
OFB8I6hZRkJxZtDCjNvF3wdvOFLl/vXA9YnnirpO3KLPM/b1vaz/qCjwjZKc
0tekJPn6pkXhvrP1h4y1fbclyzeG+xUcm/JQOXUcPal1cAu619lXJGmbcZCS
fJ6xsTgraFpG1UdDgxOPFt6/O9kzafb1bRPn6hONbekZmxUFvVGSTFOSq1ST
IN/l+kyjpe/ypD43Bk+qfmzdg6VTAjNKi9sFN6f6lye58ac8N4LMM34rvhA0
JuNucevgfseuPLg1pTBJcyN2UpQ+1fgFPWPjomkVd3l9kp98z1NfTfbdqb9r
7OZbLynqut9Eh6NX7sdOnpJR7ZFz8JdUkzM0FgdfmaRNxs7iq0HOGdnF9YMt
j296uHpqs5SRN5f4BemTjI1N4z6NKv/eGyY5o/+A+uqo/qFR4ftt4rWijb5t
jly+NzpwZkb9Rw40OhuLz5mSXH/FGLUxzR0n6u3qwenHmxdPCWqaOurWNeVM
/U5jU988fROqdpa+Fs2LNxmjs5Rkoq9BX2oc4/txYjd6ivrpgXdtA4IzPn5k
H2xGSS4G2VB/Fr0iiRXNLCnILiO1+HbQ1xmTi68E/WCYdfseH0V98oGpY4N9
s2levFmSHBqdCTRGNYr8fbfrzYo6++4x+N25oOqZkV78jNaNPXSv8tUDqwpW
lbdfVdAt6JZ/yx5UT/NESuTqaZ5KSVwtTbGk5a4Ix6VYLklIliZz7ppCqZ6i
x2z77CSnPN4gWrPDVR11q9j+Kla3lO2saqGLeI0jVA66jexqVYTuPsvznLiB
OTPjbsaVHvWEJwWHvKw1zeQC7qZwQVrD/ZGkzLqa3yU9ZxRypZXcL8IyyZPL
0GyTFykmxvTNdevX3b+1fpZNU1WJOJr1UnXX/fKaDPaq5rqZlNxet5Ldqlqs
q2Vjzz/TOjJmoWOPJndRr5if/9xDqflW7qi4IpyUFr2UpNz7Qp70K7dIiJIc
uU7xT+Sq3k4Lzp9XDToSoE8c0PYEv138kP1RNUC3u9IMXVRf6tRsJ9UXuhns
AJUtVW+DKlL3OzuU7y3OY9pPm5O2p1PGspt5VdxTNZvlhYpMIVEK/1OSJO6x
IEtbuFXCEsmVu6tJlg8oBsbuuhQzZMHkn5Pt203lR4l7GX8Vp0v5iyTlNSlL
4kLjGMsuUU3WSex6frFYwIye+iClpL3rkilXIoeVaK7KOxVHhENSGPe+aURe
TPJUMErbuR3Cr9JoTtD4yt8rniy5eaWv23tBR1N1Hbx5VlxMSb7TGdiu9Oyz
/iJJ2eg4qSx089hw1Q+6LLaUN4q92d8CuaQP7NIXMhfTBz/VnJZPKk4JKZSk
tqlLX+zbKprb0l4uWdgrBXJ9NdZyVcXC5eK11h7h0xsc8evcj+8qTmV4lYcu
le2u+ko3+zV90kvVShfFBlDyI2w3VR1dILvPf7z+qM3AeWfPFvavHX9HPqPI
ptGZydXUPJAOVST5wJSkhua+dJA7IhyWpnNfamrLWdyOuCUFE7yahMce9+7e
kbcRlYxK5a5Loru01kW/pm+7qsyobhNVw3SHWHdVD916dqcqTCez+VFzT7N9
68c/lNMoSYoUxVXX3JP2cy/P5YfSYe6MkCpFczeEi9JqLkGYXTZSEZdP1nXo
wDNiEOOnctMdZh1VbXRzX5OkvHt/VPXX7WSnqb7XnWSf80WiPds48s6pGb1D
aO58rrgtXJE2cM+E69QVWFWwqvz9VQXdgm75t+1BE6l/OnLjhdNSe266UCg5
c1uET+UgTicw8hzaL7zkG9yYyLbZ6532K9uLs5i+/E7xM7YL/6tYn7Xkl4sl
TGVakFXYW8pvRT1TqpwkZjAX/HpqY60PhtfJeNJ9bNzZAjuvBcIjyYtzFfZL
n3C+piTlKoXzUmfuN6GR7MfFCVXk7zmdpkPhWsX7MWNye/Rrr1qqq2ZTi58q
nmf68fvE5pUmKcvwjGF4QazO3lCOEBOZhnwQjWCQ37PDn1urpw87Yui8cnnx
NW+Pa4Kr/BvXU9go1eTKazJBOCN1MOXpwG0S6sv+XJhwWxrAtY2fWdjMu96C
kvOTBmn8P048Y5ukbCuqGQ8+WWQrSVJKSZZRElt+pfgeW51XiblMHV4pnmV2
+HXVTrSeGvSNYWPHD5b9mDdmuK0mTq6tsBME6aFXeTX+GKMcqR11dW35R26O
8EQazj3U9C1MVuxetP1S1BCfwIKkU3aTlJe0lswYPlvs8Rc1KUvC8vFiNbYG
ZTjHPFf+JB5jbvtN0R60vjU5OXlju5TFn11pMOw7zTHZQWElLJZuev1PNf7I
EyfUksdwGqGBPI6bo8mVvRXeSxyu2riVTBmV+l2HTso12nvW4/nzojNrxa8Q
n1cyOiWm0anKNuTDxELmhtJd3M94Kc9rLZh+AfaJNdveW7DnQtPBY2kW96ea
rJLuef0sZEt2L41RtHBXGspto77157pqlsrvK3yXd8lv55E4bW96887Wyq3a
QuuxfKbowLK8hu7110ka8xHiLSZfOZxWiXnK37XuTBXVz7rN7OOYi7mf9Z+o
0coDFB2EddIjr7FCpsRWJClL1ZZTC7ekwaa+nUpzMFC+yB2O+1yK8nINszze
rPv7ysWUZByNTje2rBNqVpqkvGKt+SX0uaxvDzGi0pJm3w2lj5jECHMW5Hj3
maE5SaPTTlgrlXiNETIkpiLJOFOfTBMkyYnbKjSVA2i3GigncLOpeydxC2cG
nLzQ6yvlFu1961H8UbEj245fI9b6yySlTEt+kfiUKaSa7KPKDKPK2NMVrlnb
zfrs1DzHYsFZPskNprfKRtxIIU1qzWFVwary5qsKugXd8q/dg2i8eO6EUEJv
Zf7CaulrzjZuaMExT8OK2/nenp3iPAsSPVfN6p61vnc7PoR6KZt/KoaxSfwd
cRK7m88Tv3/JPfw1cRSZL45hd/CXxKFsiaqNfrON5N8scZ+tRpWnG2gTMzP1
xLWeGXE3CyK98oWP5VhuA42aF7373ZMCuLI8Kk5L+nET4rYX2HhFrTiYb+15
Me5ewWyvq1ENzzzsu0lVqHO1WcLrRCf2FP9cDH1Fkt2mJPv4AnEsvRXniC7s
bVVT/XybZ/7WiXrbnqowXWsbbWinY191s1sxKv+6h43GW77CLafdoT+dm+5I
/pxBKKbT01FKFcItibtRYE9JxHxzz87CMGmb15p50ed2DXgvoH3iTdvhfLj4
mLnE19XNfWWSMg/yheLP7DI6f3Vhx6kW6RrZXPNvkLjddo7qrK63Tf600PSa
nQ8tu5pXw32yZr3cRREjHJS6VNSkPE+mUEpjdDKumjTLa8WKtPyeno/jqkvz
vbwWfnIxa3BCYF5Stl0tvp0Yz9zgm+niK01ygJKMZVfS3urC/qRapatnk+3/
XuJy22RVQ/0ym0FBz1LbdQxZsvHKymEb6Y2dV6iF3dRLSdQ//lyKKU+ycJ/e
0s/HPS+I8Nq94nL+IM9VcdsKLL3kWOHy6KElUzqmduqQoXymHcXc57/Ura8Y
iz8n2cdL1Ce/8FniENZKNUyXym7xv6j3t7X2n6B/aJMy+UDy7Ha3F/54sbnr
r5p02U8xVxCpJnp6h1FSn9yhPskQfpemc72FMOm516EVT/L9PQfHjS3I99yy
9LO8wcNnTpuUvt/+lLKeOJZq0phqUn7HypKs409RxzZVOeu2s7/55+hH2rr7
L9Lb2e4OSEr8re2QedXPTRmwW3NcDlPMo5NdV04UbtAbS3mec0INOZrzEhZK
tTlpRZeCMM8v4zoXbPBMW/55vqVHQWjssZHdtisfaD2ZO3xTncY0Cj+9cgbl
04l4G39ZHMEm8jfFb9iB/gH6urbL/E/ov7dN8n+qn2fbMvrC6dN9MzT58mRF
NNWkF3dIKJJ8TUl47pTwXJpJ71ebJRvukzingiOexhUNCkI8161Iye/r2Xjm
oRPVeu1WPtV+x1znP9ItYw/z16kzK09yURzJpvO/02+6+vvr79no/R/oY2yr
+vfU59hoI2dlNXHqS3PnCbdeOEtn/L1CvjSWw6qCVeVNVpVk06qCbkG3/Fv3
ICWdOhkuRzCX53OJy6vkqz26Rkw5uaLXzaBEw/qOZtNOpJnbt5psk1xq50zv
eCXMND5VtGcD+ESxLcvzIr0tl6uiTrNh5/PnxMFsFH9G7M0G0vcebM/ZY7Lt
nR/Fai/vGjppoffFOq5nlvx0NdRtgXCUTvpxgpG6eqFwQXLlgoRUqRO9G9+Q
FFzyinoFUZ7Bsyadcu2dGfSj4WjHKdOY9IH23af0TKnffjrdpTPd8RDdcQqf
IrZ/KUm5aj6TMuj5WrrJ7FTlOa034xRRO7O2w9PY9MvrhwYtHHSxjWv24sQr
ocOshBhJ9tpK4zWeW0BJBnPhwnGpB52kjkm2XElcR+mKl3HOkpwdfT4NPkdJ
Rk5rnW5n7zz1Rkq9Drd4c90q9lt+O52ngqlvO70iyXQ+XezKnuPNdPPZO35D
tbnW5mE3j+3oFhrrcvnzoVsXLr7o5Tp88fXLqUNXx10tcPFKFT6SI7m59G7c
j1MLmZIj5yfoac3JE5rIB7hqc0/lftx/S/C0tDWdrKadT/u90/GpR1PTO/ip
DLoeNi78QnpLD+OPi91ekSTIlDCd/1AXyXZVxmqN1h7Thx+p0eXwoqWXJg55
uPDExdmuu2NDL9sNtYkLKbjumSt8KS/mouhc6UKnlRypL50dDkutuCdCR/k4
lzx/xPknA5dOc0sfY28M/iXtaCffIHuDT8fLqpZ6waYTHyHeY2byJ8Ser0hS
NmodWC1fQzeFnag8qWWYbUFBhscdv1hkvLjF1WpR7UunXA8tir00Ysg0msV2
lMRMXsrF0EmhP50UTlNl/OkNh6G3mmbyWq75ol8vznUNnZ6dntpZFxyQJnRS
BDdLs+20iGaKh20nfqZ4hwnnM8TuFV36YpJAPklsx27mH9F8P6psJkYxbpOX
JKvbNV3Q9YJqkGbRD5eGDOm1qOWlm66hyzvn23nIVJP1VJOzVI35dMIdxNG0
kFjusmAlr+GaLhlx5cCwqaHHj47vOinYKa1zpxPBIWnLO8UFBCZ6tLXiI8Wr
VJOjYq9XJAng9TSnVvM36M2qMT+KznRL/K/o99v2nPvD2Z/7N4vNv5Q55NNF
ty9ucN2/7MNrHdwzhaY0OmUdO5CLFS5JQ+gktU9qw5UKfWUtN3rZjrwG7rvD
rTMa9bAIvmd41vF28Na0zE6jAlclDbfrxkfR6ITwR6gz/em+tq+Yy8tph/Ji
Xfml1FHzVUbdXBtNVPHpp31nxfa93GXo1YXpFxWud5YG5c0bni7Ukedwi4TL
NIsXk8Po7K+lmmBVwary16vKIuEi9S32IHTLv3UPchfipQ/oN23kOC5/mdW1
Te7jpnVP/83e2m/T4VSrHcpG4o/MbWUfcS0zhXai9qyS14rMSznLvmHZyfSv
dvQeeFf8kf2NfyZ6sg78MtGf7Ty/6vm4gXdX1i5KGfE1vZ/LXDfNFPk59wu9
hX7PCUKBxNEbe740nPte2CJ9yUXSjHPhwlasobN2YWjLY826FU4ac3iK1QHl
Z6KKyVXaijHMz/xOsRX1tp56+895yuddHF9Eu8NF3kYXx85WntAOYj6L+un0
qL7nVjYu2j/CTvOtfJMbqFks11dsFZ5RVy8XrkketE9dpCRKem+35RyFpdJj
r7y4qtJRr0cznU9u7dXfL/fwKat1yqriGCZd2UQMZb7l11NXB9Czt31FEt5U
mXn8BXEgW0XlojvAXvVz1K63nhfRJzPNwWnlJGPzEQrNHLmZwlMTK5tTkqfS
JG6ZkEcZlglXqTI8dXV7rp+wUqrGPaLezuIGzI7N/snZVnlIe9J6sjJHyzIi
vRVMZEbyG8UmprcFu1ckKV95yua7I/uMd9btZtP8bLVzrfeHjT0+r/uY+JhC
c+/5mkTZSzFes1pup0gW6sszuCXCFcmN1p8CWn9C6FTVketDNXnuVTaOVRWZ
0bvOlLh8Q3t0bbazUqO9Yb1F2UD8lhlA416jonv9+MOi9St6eyZ/knreyNvp
1rJfKGdpC6wbTj+Sntd5uuZXOjcd05TIixQBps+XqDM13FKqxnBa94zSCFp5
Tkg9ucFCnFSb+13oLmdz0fON57YNXK7S69rblPj5aLdbr1fWFb2Ztvw0sYgp
f4N61eiUGUazryvN9090Mewh5afiaKbn1FapazqsXjGwINBzSLxvYSPvcZqN
spXiruAgb6c+yZPcuRWmvp1Jq58j5y6skRrRGbM+nYLNYtWXEofIAS2T9rRN
9munnWS9TllF/Ib5nN6XzjABlYxO+TdBtGt0ZPfy1Wk1ZvmpYjazOOBaYnHb
C0t+vbrG7U78e8Zd3sOoW5oqSgVn2WB6kxlCM0iivSCGVsIhnKuwSqrPPRV6
yAe5VktnXS10az11ZKpbB5XftcP1rTcp3xdHMR/y34mJTNm9OlU6OpP5ZKrY
NprFfuw3/GbxPXa7qqpespm7aPClYteJKyONDiO6afyoB8w1o2SJRieP+kRj
SlI2gwZxHtSx9U2rygqsKlhVKl1VooQsqRc3XNBI9bjz2IPQLf+6PegzzXj5
Onda06gwXHF2+Xv5Sz2ipw86cqVzML1vN2eqqHrpktgl/GXRrdJ9oayXbGkd
3kij/FjZU9xJ415XHMf4K/XaKKbxvCdnRw7QxGcV/uydFWcpzfYKEJIkO1PF
OFNmN26r8EhScTaU5BoXqsmQ7RTquPgCB6+64R7HFd3NlEu1ButGqkG6HFbD
SyJHJ+7E/zpxlycpH8Ef+W2iGftM2UXcwzwmVzI7/R4fHmP9xZzxOc595sUX
FI72PhfXRprnNUHYL1mYumh4RZ5EoYHsz1nT7CviHDUxspE7S9n03KfqEZkX
HNYoPxHbM0/5jjo9u4l/SLN4Mo3gq/durckkylOP9xCTmSa8p3iUqe439fB2
q+kzh55M6PVIY194TFFD8JD2e40WtktfmJKU7VOy9A23W6gmf899oRkuH+F6
U//f5W5o6hQeUPwwZ3NObJ9gmrnt2Ay+rm4Ou5svpTWkbE981cpT7iQ6Z1mx
Lfjx4lmmBc+JJ5nbk4Yc3my1J3TOsYndmmlGyke5HsI86amXu7Cedsbyc2VZ
EgW3Qbgj/UC7dn+aWV01kbQmfBHfobBAcSrml9z3+serbus8bWL4U+IANpWv
p4tgp/FpdLr0oyTWlXZLK36SmM/U5weKB5h+fqsP17D+elpRWpZ9W2G6dM1r
spBO86g/dW/NipPCSupqb9PJbhj3QGgv7+ScNGr5NndXY114SLF6QdULGYNS
/Z/ow20H8nFiXTaLb6pbwM6gd6celY5OWRfZsB3pTeY+c0dpKa5mrvq11wZa
fzfFJWV9+8Dl1vmdPH4Xusi7uLZChHTDK1I4KTlRn5S9Rfwi3KJZ9kBwkjdT
n8yWf+eOamoXqhVfLg65nDa03eQRye+3+5QfK55gLvFf6QR2Nn9adK50BgXS
2Nmxg+lsXoctVNpQkkHU84XWG/w/T7xlu27x9Cs+wzSabNlT0UD4QUr3iqAk
PU2j482tEW6S12gFmMN11kyUb3C3NVaFqxStl0XlFQ7/Nkht2NjRQH07nrlF
K8l2NobPFftXuuaU68GvExuxT5WONIOmK/drzZgMvq3uNjtyofPF7YO/iB9W
WKi4G9dX2uAVTCNlX5Gk7P3KkzPQyTeWa6GZ8J9VJRerClaVP60qG+ndZgz3
THCVL3BfaybLxVyWpmFhKPYgdMu/ag9SRcpZbZ2qqfdlig4WETtPXu8VN/li
8sp2V5VW4gJmMX9RdKdUB2iMJvJ7Ke2LzqL9y4ntwE8WbzL5Kgf9DptvZ7Q6
cb5HnTndctg+w2evyw5wPrCk39X33OZq0uWRiuFCvNSAEpadtf2EfRLDNdBw
8jlu2rJ9eY+G9589M7uuc2LE4sxgh+MRAZnxDvWmfpDq1CFJ2ZhmShx/VfyG
qnSQKvPnJKG8QezOevMbxC/YWipn3U72eBh7vGb3dnNm5Azso488m7XJ6cfY
65dWDlmmyZUnKMpOTPW5ecIZaTAXIGhprt0U2tFOenH51/k/egTOuZrzU59x
9IbfxmGBuiizpWOP4HRD504PlN7ir8xCPlscZvp/ntu/IkkQ9bM9zTItqaZU
LdmRIT2OZndJme2cY95nYWRB1iSnUwvWXvhgcB/NVPkzxThhj9SKRjBL6s+F
CgapG7dXqCGHcXXjuhTM8dwdHX4m0MUtonlmA4fj6smnFjj6Tz+fHtF5I18g
KuiOB6hnptH86kLdu48658UkAZShHTuHzguD2bo0szYx94Mt0kfbu87+NXuN
syZSytrqdG/e1+c7DjwrWMu/crOEI5IjN1vIpLPbDPrswK2nNfAHrqbQUTJ4
Fc7dcvZm/8AIl8zWDrL6u1O7HPeErDrKdL3BO+jW0cq2lla2UOrq7q9IUj5q
8/kz4lD2Gp3+FjKfB3kaunQsjnTJPuqUEdkiu5Fz1Nzos8v6q+m+NrTOXJO+
49RCBr3PRNJJoY9prg2lhDrq8xPzR58/N3BbxNjMUQ4H1apToY5M2K1jZ7qp
VLt03W0c+CjxCRPBH6NT0p+T+JkqtsiU5IKykxjLjJvSI6Vz+36Rs7JqOH01
e0J2H+c50YozP7iMittZ8JFXltBUXsJNE1KkrhVjFCYcp8pcFRrRWXvzQuXF
osE5EfGZyx2WqAeccnVsMaNPxs89tvrn6pW2X9GUvsTMpjnSh+67j+77cpL9
9E0UjU5/tjrvLh5k1gTuTOLtYuk6uxzHz9ZlL3UumtPytL7PguU3rzl6tNB8
L1/lJlC3WHExQrY0oCKVJFjJG7mGi70vmw1NVnc4pXIcpv76VHPHcTPPnCjq
GRf4Q9IIu/f4H8REJobuNeAVc7m8SrPpX/uyn/PfidnMPf+BiXrbUzPjThb2
2j47L/um88PZw3OeORcv3Ze3Yvg3mvnyV4qRQgKtxvNpBrnSWfuAxHKf0Iny
Kldn6dCroW51I4Ozknt/pD6SmelgF3Hw5AOsKlhVKlaVTcJD6ScuL66JtM7L
f57FuSkDXGadP/XEsZ/6cWYdR+xB6JZ/0x40PuB3fdu2fn7iYYW1UrlWO5Sp
y38lnmcG8N+LrVkH3osy9+YV1DMv6sR7i83Z8fwMWpOvKG9qDzI7A24nzmyr
X3DmQoPB38W7FY73Pi7clvZwU4UZ1D+fCoz00Mta6E5vg18L9lIVrijuWYHW
q47mM/k+Fx+bcKnq0KzASUnN2nXyCz1cz3qmcpvWl8lX1qK37kGUpNVrkozk
A2h8bfju9N5o7f+d/plN/NxTZ/P7d4xfUejifUm4Iu3lFgrLpFFcM8FaelCR
pI3QWarK3YurIaV5pQvnpR20O3xCu8PEqdVSd3RIn9Tk8BqreOU+rZLJUV7X
rmR601t3C7bMz//jf+fx5v2o5wfwI2k0J/Hz6Pct5xzJqdNniaZF4V5FHc0j
6TK3nfamMO5zoa30yMtK6PafJNWFT6QLdKKZIzlzpcuMeUXujaZ3Sw/rvHLS
80PjrJYq92uDGYMyS7uYceFHiOasI2V4VU3KdeN9qK/G8dPEgexJZbF2PiNG
+GS2dzgkOMgHOAsNIzdW6ISj0hLOTOgkPfOyFLpK1SlJF6ka96HwlVTkZSP0
kWpxcSuW5wd7rgp3OX6j+8NJFocPWPHKBO1IZosyWzuDauIpNjPdsXmlNXHl
x4htqM9niq6sQPX8huHDf844070m3fGB11DNWLmvIo3WmV84K6pDNeqQsgwW
pjwfC62lm15m1DOlXl8LLaR7XjXV205mO/T0Czxsbf2tMlrbg5mt3KudyLTj
B4j12T78N+KXpsq8KslAfjR1tS/17SB2B1VSxViEfHA0ssvSFV0KIjxHa5bK
XooCOqHs4joKzrT6taLKPK+ozGfUww+83hfMJclrlbCcTruHZn+Xvdx5l1/R
YcHaQTlB+yUTpVyldWXM+S40v5ypM1tUWpPynFP4ueJwVqmM0fZhPIO8DIM6
piy9nBc3fJMmTV6reCzkSQZuoKCQWtIYtTeNUTepBveFYEOdU1NoKuVSki3S
Mm5PzPUz9fp/zncSHzJP/Tpo82gGxWs96ZxoJd6nbvle/Ipq8uoZ5Ey91IKd
wIfTXBaVZ7VxzKTJwcnO7SJj4y/fHPJQ83lhde8bNJdTudGCP73RfSHYSo+p
b8tmkJlgJz3xKo1rKGV6raeT+ApOs2Dz+XOD0vy/1c+xneN35jBPSXZpf8Cq
glWlYlXpKAykmTVixQ/5PT2FGc0zrvZop7opXmUf+3XVytiD0C3/qj1IN3lk
ykO7o3wz/SNmteqEPpP1Ui3UR7EDVWp9MDtIFakPIWfpp7+kq2q2PpRVqjbr
f2Grqtrq7VhDYO+Ux22rLRp0WTc4ZWVu0UcjzOPHG90UC+JzjBmKX+OLjNcU
v8TLxiuKtfEFxkuKsfGbjIJCvTKlKMu76dKheXeHWU49l2poH83n6jYx6apH
+mfsd6pl+vnsAEoyrdIkg03f+6jW6uPYzqoJ+vHssIBdSVNtpXmOFxYOiFvZ
4vod75bx3xs9FLPiTxqTFRtfSLIuXjJeVkyM32H8ReG0clbRQu8ly4/kj3NP
Cw5Jn9CpOe+j68JcUjVKbGwzWqXRLzXda/orMrzoD6p4/RKqYTQlX6cqpvpM
iOqeu75P1ZUrikZ694qfYpykmByfbNxNNTH+V5KQ+ETjfsWdePuiNt4L4xZK
KZ5TQjcfs+36u3KIrh6dzj5M/NRmrOoXetKBdK9ppju+qibljlAt0cewU1Vb
9FvYR3xvfS32sfpSVrrDl/EG40iFMn6tcYPCJ36ncZ1iQ3yhMe+lJPOoVmn0
/X1jgaKDpm9hIFcrIuXk0Z5OfJjOm8lQPddXseFVG+npKhuXF/Wkjopkp6t2
6/ewWr6uPoeZNyPt5KgeYzT6wm3cL/HnjacV38evN66gDIWUYb0pSXmeBfFZ
xqMKDfXMWcpzhL7xjeyZ/WvvefwxnYHZp7quv8aGqHbSMw5RzdGHmSpTeRIP
1QL9LNZf9Zv+NzaNb6y/wowM9T3eouv9uANyZ6/98R8V3VZ4x8cZlynW0B0v
UpJC49WKJMvizxlPKSLiTxiTFK1X9i8a4d0humYu37eqqre+G7tMdVSfxM5U
afUH2eGqufqI19RkqCpKH07J9+l3sIv5TN1eZkHwifQrHVstdy1wcK+6sl9R
D2+X+PnGmQoh/orxDD278T9jFBd/wZijmB6fSl3UYaV3UYh32/mh548PCPKf
kyjYuKnm0ZWXqI7r01k3el61aS6Xz6BXJSmvm4pqsoG9wDfR12TjppxPPdru
7GKzvLlDPVbGFa327hIfbPRVLIk/a8w0zeU/ksTHX6ZxmRx/yLhZwaz0KVJ7
W8a6XM50bTJZn+xsV8C31Tdid6qu0BhhVcGqUr6qbI3/3XhDUSx8WNiJq66O
z0zvNSNgcNJK22F05QgWexC65d+0B+WPD9ryEdPHJzzB30L2qbW5sWWaz42E
YotkH2PCfYuUSjT4XKffnPEpSahpecDnbMJtC7/xX24Jtn4vxFvXrNd9dcO0
z/rlRpSmGvs2Vnc2WLp8pu5hsHH51GQzdXcD43Iror6hmss+dZHhuItLWFxi
suOmCVu29mFb+gxJcLQo9THbbGdK8siU5F6lSVJ9ihIeUJLnlGSnz/GE6xZT
xnn/FmZ1O/hr7aPuDWd1SPu0X1ZEcWpB34/UnQytTUlsK5J8SklYl+KIJoY6
LmHqbYYVLvVnSElBTrMnOm6/a5P90wcJT9o0+Nlms4Nlus/NhMevqUmKKUm2
z+OEUosjPvcSPrIM+nnR5m2W+VPmH7zVZan6iSHXpTCimuF+33pqO8OXL9Wk
PElpREtDExd3ta/B22XFzNEpV5yf+4k7c+0yf7qz6Vmbej/bbe5medznTsLT
v8jwP0mO+9yl6hX5fLjZ1jLZ52pCNcuagWv2ne7UXD3YMMilhrqV4SOX99RW
hk//k+EPWZc6amvDFy5t1P0N3VzWRRxPbdX3I3/fPds61PBpkmBu8dSn5WYb
y5M+DxKev0GS+xbp1C2PLO74NN9sbqnxiUw4bLFE1XSPsf2OiEupkX2/VPc2
9HKppm5Nef47iY1LfXU7qlV9tQ31jLN6BqUaGViyz8++jc+3CT/QNRtu/twy
y+dRQnXL8nv9dZ5jPrcTnlhc8KmxuZ7lTJ+ohASLQGWtXYftLsx8kLKqj4ua
N7i7PIn4wtCwYkReTNJI3cHQksaojeEzl8XqFQZ/lyZTbQ4Wd/H3WZuwxuK8
T2nC+5a5Pk8TalmW9+Rfd0u6z62E3y0u0l/VsAz22ZyQa/FoYtb2nrZyeGDy
WacJasEQ5fIworGhlktTdTeD9Uvd0tjUybcjzAyfuOSqNxuCXI4FV9Pmd4/8
ecHmp5abfE4lnLDIo2f82LJsnj58TZKyWfaYalJKNVzoo6O5ljlh99ba7PXQ
fom/OK5XpxiOuRgjGhh+p7ncxWD1UpKm6q40u29EfGh43yVDfcewwWV8yCrd
zF5DxtfcEmU90ic2Icrivk+jzV9hVcGqUrGqMPRLB5eAiA2pj/oc9a+516fj
qHF1fguxWuVzLiEHexC65V+1ByW6vxfWxdzg/nFYL/NU90ZhPenz6y3/5RHT
X+1xrxfW1fx9j7uhPcwHe/QMm2xu5TE1LN2c9ZgQpiMnhSW+0glhSeY2HtPC
RHMzj15hq+hqNcP6m6e4fxLW7Y0yvOxHYT0o1Ydhvc1z3KvQFWw8uoUFm9t6
TKbrsx6+FffVV5KkzCD6pZNH3zCteXWPKmEq88PujcM6mqfT9R3+Zp4e5klU
GSfycWhnc8ajd9h0c0sPdVgapRr3lzWZSFp7KClJD49Q+uU9yhBqfsC9ASU5
Qs/4d5KkmWqSRDqZ692fUpKeHp3Dws3tPaaHnaK7TDBVprIkf+QRTWOUYH6b
rjPRXKSx7kA1+btJGlGfJJLdzI+6Pwvtbt7Ho1bYAEoyKWwrJZkUlkp3qWx0
yr5nPPyoW+yoMnvMH1A1Asy1NNb2bzU6ZXk+NlWmdpijeQ2PBpSks4dP2GZT
5XUVo1BZTRiT9h7+1CcdPRqG/Wqe4f4BVTiZatL9b2T4nxnU03yXex3q22fu
tcL6mrenau+mbuFNs+Ovk4yn37TziAg7TDNucNgOGuWyGWT4mzPo5SR1KUkV
j/coySC6u46urAxLMdWk8tEpm0HJNNemh+00/5SSrKAKPw91pCs3fsuaYFX5
d68qWtMYbTa/5d4wzNf8oHv1MDuqySdhjtiD0C3/qj3ouVtxyB6zKsMfvoXP
3R6Q1Yc/Ctlndt/tacgus0tu10JWm111OxMylzwbMt/kvEq94naafiO5XQ1Z
YVbi9jBkh1lVuvLet8xT7jO3xyG7zQrcCijJFUryugx/JCn75SW3yyGL6Fke
hiSYVaOr7aNnfJsMZU+xm3xCnwspyRqzPLdsU03OvUGeXPrNZbeckIVmxW53
QjZQhYvfMsneiiTVKMleqokxZC1d+XRI9BuNTvlv8ijJErOHbrdDNtJ1ysa6
yvAHb1mTspEtT3Iv5DdKkhsS+9K9Ksvwx+czNDr3KMl60+i8fZ+U539E3nW7
G7KVRv98yOKKyr9Jt1wydUuB280Qjdk/n0E1KMluqvDDkO1U7dOmmuS+NkNZ
L82jGmaHLDDNoOVU4Uc0B6u8VWXKu+uPJMUhO80uUk0WmpK8+VxeZGakGVRW
k7LrlNX5bZJgVfn/a1WpOvzxW68q6Jb/37rl/9YeNN3bL/zDlsHeE8Prv6VB
JkO9J4U3bDnfOzTcrOVi78hwy5ax3rPCLejzq/3jXyPJBd7h4S1bhngrwxtV
XK3syg3eMs90StKg5Vzv6eEt3ijJ4heSLPKeEd66Zbg3H/6JKckH/yBJgwqj
vKeFf1GR5HUZXqyPOvzrljO9/cObUBLfd5Ckfss53lPDP3uLJLPC27RUeweG
N/vHSf4wkq7WxHT9Nn8jSbmR3lPoKf55n5RbVuFPKqr9d5NEewdRj/2Tu784
g8K9VeEftVzoHUEd+Kbj8kffzvUOoXn3z6tRniTMNBMX0Fxo9Ubd8mKSed50
PDXNwYav6ECsKlhVXl5VJtOqMs1UW+xB6JZ/3x7UfL9iZZEjhBBCCCF8V9Y5
f37jmkEQQgghhPBdeeP0jA2x/SGEEEII4btyyPlPEq14CCGEEEL4rqxz+f7Z
MUshhBBCCOG7MufSqlz7xRBCCCGE8F154dKx3BkQQgghhPCdeelSbu5iCCGE
EEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGE
EEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGE
EEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGE
EEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGE
EEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGE
EEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGE
EEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGE
EEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGE
EEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGE
EEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGE
EEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGE
EEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGE
EEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGE
EEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGE
EEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGE
EEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGE
EEIIIYQQQgghhBBCCCGEEEIIIYQQQgghhBBCCCGEEEIIIYQQQgj/l/r/ABBW
hlw=
"], {{0, 158}, {400, 0}}, {0, 65535},ColorFunction->RGBColor],
     BoxForm`ImageTag[
     "Bit16", ColorSpace -> "RGB", Interleaving -> True,
      MetaInformation -> Association[
       "Exif" -> Association[
         "Software" -> "Created with the Wolfram Language : \
www.wolfram.com",
          "DateTime" -> DateObject[{2017, 7, 25, 9, 51, 31.},
            "Instant", "Gregorian", -6.]],
        "Comments" -> Association[
         "Software" -> "Created with the Wolfram Language : \
www.wolfram.com",
          "Creation Time" -> DateObject[{2017, 7, 25, 9, 51, 31.},
            "Instant", "Gregorian", -6.]]]],Selectable->False],
    DefaultBaseStyle->"ImageGraphics",ImageSizeRaw->{400, 158},
    PlotRange->{{0, 400}, {0, 158}}]\);

You can even restyle your images using ImageRestyle:

Input 47

artStyles = {\!\(\*GraphicsBox[
TagBox[RasterBox[CompressedData["CUSTOMIMAGEDATA"], {{0, 150}, {150, 0}}, {0., 1.},
        ColorFunction->RGBColor],BoxForm`ImageTag[
       "Real", ColorSpace -> "RGB", Interleaving -> True],
       Selectable->False],DefaultBaseStyle->"ImageGraphics",
      ImageSizeRaw->{150, 150},
      PlotRange->{{0, 150}, {0, 150}}]\), \!\(\*GraphicsBox[
TagBox[RasterBox[CompressedData["CUSTOMIMAGEDATA"], {{0, 300}, {480, 0}}, {0,
         255},ColorFunction->RGBColor],BoxForm`ImageTag[
       "Byte", ColorSpace -> "RGB", ImageResolution -> {72, 72},
        Interleaving -> True,
        MetaInformation -> Association[
         "Exif" -> Association[
           "Software" -> "Created with the Wolfram Language : \
www.wolfram.com"]]],Selectable->False],
      DefaultBaseStyle->"ImageGraphics",ImageSizeRaw->{480, 300},
      PlotRange->{{0, 480}, {0, 300}}]\), \!\(\*GraphicsBox[
TagBox[RasterBox[CompressedData["CUSTOMIMAGEDATA"], {{0, 276}, {400, 0}}, {0,
         255},ColorFunction->RGBColor],BoxForm`ImageTag[
       "Byte", ColorSpace -> ColorProfileData[CompressedData[
"CUSTOMIMAGEDATA"], "RGB", "XYZ"],
        ImageResolution -> {300, 300}, Interleaving -> True,
        MetaInformation -> Association[
         "Exif" -> Association[
           "Orientation" -> Association[
             "CameraTopOrientation" -> Top, "Mirrored" -> False],
            "XResolution" -> 300, "YResolution" -> 300,
            "ResolutionUnit" -> "inch",
            "Software" -> "Created with the Wolfram Language : \
www.wolfram.com",
            "DateTime" -> DateObject[{2017, 3, 9, 11, 56, 18.},
              "Instant", "Gregorian", 2.], "PixelXDimension" -> 750,
            "PixelYDimension" -> 519]]],Selectable->False],
      DefaultBaseStyle->"ImageGraphics",ImageSizeRaw->{400, 276},
      PlotRange->{{0, 400}, {0, 276}}]\), \!\(\*GraphicsBox[
TagBox[RasterBox[CompressedData["CUSTOMIMAGEDATA"], {{0, 250}, {400, 0}}, {0, 255},
        ColorFunction->RGBColor],BoxForm`ImageTag[
       "Byte", ColorSpace -> "RGB", ImageResolution -> {72, 72},
        Interleaving -> True,
        MetaInformation -> Association[
         "Exif" -> Association[
           "Orientation" -> Association[
             "CameraTopOrientation" -> Top, "Mirrored" -> False],
            "XResolution" -> 72, "YResolution" -> 72,
            "ResolutionUnit" -> "inch",
            "Software" -> "Created with the Wolfram Language : \
www.wolfram.com",
            "DateTime" -> DateObject[{2017, 5, 30, 17, 18, 42.},
              "Instant", "Gregorian", 2.], "ExifVersion" -> "2.21",
            "ComponentsConfiguration" -> "Y",
            "FlashpixVersion" -> "1.00", "ColorSpace" -> "RGBColor",
            "PixelXDimension" -> 1024, "PixelYDimension" -> 640,
            "SceneCaptureType" -> "Standard"]]],Selectable->False],
      DefaultBaseStyle->"ImageGraphics",ImageSizeRaw->{400, 250},
      PlotRange->{{0, 400}, {0, 250}}]\)};

Input 48

cityStyles =
  Prepend[SetAlphaChannel[ImageRestyle[city, #],
      AlphaChannel[city]] & /@ artStyles, city];

Input 49

groundStyles =
  Prepend[ImageRestyle[ground, #] & /@ artStyles, ground];

Input 50

groundStyles =
  Prepend[ImageRestyle[ground, #] & /@ artStyles, ground];

Input 51

domColors = {RGBColor[
   0.44313725490196076`, 0.7725490196078432, 0.8117647058823529],
   GrayLevel[0.9], RGBColor[
   0.8257116158191437, 0.7624872802598549, 0.6834260771904932],
   RGBColor[
   0.9275118744483869, 0.8953480709038453, 0.7543210863558273],
   RGBColor[
   0.2386547585427879, 0.4876022587659778, 0.7371873300590905]};

Input 52

styleControl =
  Thread[Range[5] ->
    Prepend[artStyles, Image[ConstantArray[1, {150, 150}]]]];

Here's an example of what the game could look like with a little more effort:

Input 53

Manipulate[
 Graphics[{
   Inset[cityStyles[[art]], {-5, 2}, Scaled[{0, 0}], 10],
   Inset[spikey, {-2, 9}, Center, 1.2],
   Inset[ImageReflect[pipeStyles[[art]], Top], {x0, height},
    Scaled[{0, 1}], pWidth],
   Inset[pipeStyles[[art]], {x0, height + pGap}, Scaled[{0, 0}],
    pWidth],
   If[draw,
    {FaceForm[None], EdgeForm[Red],
     Polygon[pipeVertices[x0, height, pWidth, pGap]]},
    {}],
   Inset[groundStyles[[art]], {-5, 2.3}, Scaled[{0, 1}], 10]},
  PlotRange -> {{-5, 5}, {0, 14}}, Background -> domColors[[art]],
  PlotRangeClipping -> True],
 {{x0, 1.08, "Hor. Position"}, -5, 5},
 {{pWidth, 1.745, "Pipe Width"}, 1, 4},
 {{height, 7.62, "Gap Position"}, 0, 12},
 {{pGap, 2.248, "Gap Width"}, 1, 3},
 {{draw, False, "Draw Hit Box"}, {True, False}},
 {{art, 1, "Art Styles"}, styleControl}, SaveDefinitions -> True]

Bonus Suggestion 2: Animation

Animation can add another polished element to your game, but it will use the CPU continuously:

Input 54

animationFrames = {\!\(\*GraphicsBox[
TagBox[RasterBox[CompressedData["
1:eJy9V2lYU1cavllwARQCGAS1jyP75q5YHChhB0WEIAFcyiIgAxJCAkanBZdq
taOtSNkFfdSnw8gMOqJS7SiyyGaCIoKMWqv94dbaYTUmN5dvzrkBKxgprZ25
z/Pm3HPuzb3v937vOd+5f4gRhsQzCYIQT0I/IdFbeGlp0Vv5hqizJkWcmJAS
t9E/RRKXEJe2LIaFBmchWCOwEVKvtv421MvHj9/6jl8JUcN1Iq2pjTFeiBpv
YH6M/wkfFHdK7TVWemsXEZKdH8i1tu0ytXO4xbWx69LAVgNrTWuKxszsHTtw
f+mGmNyM612EsPYa8/fWR9x8E7fMbZ0PiIBd+9YjC8B4MdvF7Wtp+7fs1DoZ
Gz3vnXVD8bEl8tuMsPwSv+l2Du0z585vM3Nwag+Niv5eLpdRzS0taplMRjU1
N1EyuZzauXMnxWSxKA9PTzTWTNXU1lKNTU3U/pycbqTht84bYo6kt94mhHXv
qFudjLUV6bPqs4Phr8e/elUQaDvKy8vp63w+f8R4RUXFIB63cOPVbr11H+kl
/9W8hMiftE6yTkZk8TEfM8e5rYFrI+41NlVTNfVn1XVXq6mOW7mDih5/6Hse
DGp1CFSe8ofFi5dAcnIiNDQ0QGdnJxpXA0mSdPv4yZNBrNtn2Ye6ke5dLjEJ
h9JRHtB7WL/MSU7geSO5dgt5qY3YdvshIcgpCsVxrgr0HYp8YKg9BYqfpkD/
DzPQ+QwoLTSkdVq7Nlyrjq/pRuH7rHjeZ/DzRVevj60RypfkWgcjsvQrt5nz
FjTNWrCo8b1FS5q4VtZ3WGw2xTU1oVxcloFE7ArKl3ykkzu87LaA/h+t0Nts
4HjpTGCxWLBuXQT09/fD8+fPaR5YK3xcvnwZnJ2dISkpabChsYHK2rv3mfnc
+U0fJKfuoedpnUx7XuvlLMyf/2VxyFjzytOdQG+ZCWTvLFD8B/Oag/pWcKzE
nL4eGSmAvr4+ePr0Kc0H5xEfZWVl9PWwsDC6X1JSQvvNaUVQJZqn9PozmpMY
5W3D8fKlMxcubvUVRNxFc0hdfaVGjdsrNTVUdXU1VFdfhrq6ejhcvA/c3aZA
5jYukC8tofuphtdxxIvJxHkUQG9v7xu8UP5AR0cH6bmO1jC/oEDFYDLVC0LW
/E16855WXhJ5JyHIL/XB/HlurmP649zZc3Tc/r6TUM+a1gzzOlKk0UsQHgkU
RUFPT8+IPA7rNTxPCwoLSdyfHxxaLr159628wguPeiD+aN3xINVqFahUSvqZ
wxieV48ePUBeOQN5eRnAc58MOz42ARi0gnsds+GbC+ZwYJ898HgfwJYtYlo3
7DPM89Hjx1BVVQWtra30cwqLijS8VvP/vuXGHWZKTQv7Lbw88X0eHl4Ujoei
tOs1OKjJy+l/lg+tY1NpXgPP59D+LymYRo+7uXnQsQwMDGh9zvETJ2heC9eE
l3189xExVD+18Cr1QOs0yeO9pyIVkaDo3YuzgKAa0SpeNMJLBR/KTrjCxIkM
WB+p4dX7bA4oeiygq202nK6YAQf22oCPlxf4envCCn8/CPDzBT9vb/Dz8YaV
Af4wz8lxkMVggJG5+ROr5a51PKFkp0TWwUa66fzM6zYhyCvypeN8n4HePwUJ
FqFdL/UV9DsVTp80oXVZtVKP9hfWS/ET8prCEvXtoeosd9y1E8NyRfA/tj/4
gUhDNVg4pBvahxDxlRdn+WXtiQ/KiM+NjjIg9+6ZqyJfSmGgOx1e9KZDf7cE
SJUUmq+GQWy0PkjFxnC4iAsXK82B7LeAPqSX8oUl/OvsDIhaPxVEwRwoXm4G
X7pMh9w3gMbfN4VDztMge5kpdfiP09VJXgvuOgWvORaQtTs2HeUPr6d0XtF+
IfP+E0JQeDQA83deiNcpM5Q6U9QikFy6f+qkAR2flw/WyQ6l1wrlzxKU/Vgn
Wygp1OjkYTIZIMkeIM4WIH4MxFoDbLaH0qWaeuHg7Xd6a8d9PD91NDVRxkJ7
GHbc6fNWAdt3Ja9Ojy6Oi+VAbJQRFR/DgXh0vinBCKSJBnBYqgcXsg1AeWM6
9LdMB6rTDK7+1QQSEgxAGsqBAjdT2LHIGGKtDCDKcip8OAY2WBpQ0RZTINTP
tcV/x6ebwguP8MQt7TiXzNfW/Fe68XOP+g7lXv26D1wdWAA3jVFh4YDqnCEo
Kg0B6jlQmDyZvh7MRd4UO0IFz3y83qLnpU1w+AmNv9pf+WvUfksH7SPYodl5
oRMmssl51pOUeRI9yBHqQvZmXajcrQ/KbzigqOIAiVrlRQ6oq42g84gB5G/R
gz1h+pBobwgiR0PIcebCgSXTaHw+qv3LYhPIW8aFtVYc1QQdNrkQrfuoTrI3
X2nWGc1pqH6zM9ruEPyDORE4jsAlyGf30drZhjS6hXDNGFRfI04Xf4bqAuKG
OEKHMZRm6Gr8xdUFSB7DXxttaF995WpK3+/kv/L81rfUyaFcMnF+N1acs/VI
/7M0MDHiWDJfl0wK0VNuWq1L5on01cpLHBg4z4EXVRpg7frPoTHET54/Fb5I
0YNPwqYM/snemIy3MyLjbY007WuIszNWJtkbkRE+y1s9Mz6Shh4qCMJ1eoSv
tHxfYJ9lffeMCDpYFDRiP+FEaPxVbwTQOAoNCE0ID6fBpf2Txrfv91l5Zsf3
PxJpLdp9pW0/hmoDO6b8jINnqjjTSyTO8s7YlhmSyD8pidQjRQJ9ZVqYHjkC
Aj0yNUxfmSrQJaPXOdz2lmzL9BKKt3umSjJHw0uU/pFHSlpm6MG8UFFjGxvl
7436OJZueP3F+6OM6/8mtj98RgTsy+GPRweTeS6Xsr57SqCaTP//TdyjW7SX
HpdOWrgxcCwpNc0TsH5RZRXz3TcLd/NSUne5b07dzcPnNIbOhaJd7skpu4M+
3f+hqOEGrncT6P+/BfS6/i7fRa/0a39L/CN1wHvj/+f3v3BYv1/A76HDfwEu
JWH9
"], {{0, 29}, {38, 0}}, {0, 255},ColorFunction->RGBColor],
       BoxForm`ImageTag[
       "Byte", ColorSpace -> "RGB", Interleaving -> True,
        MetaInformation -> Association[
         "Exif" -> Association[
           "Software" -> "Created with the Wolfram Language : \
www.wolfram.com"],
          "Comments" -> Association[
           "Software" -> "Created with the Wolfram Language : \
www.wolfram.com",
            "Creation Time" -> DateObject[{2017, 7, 25, 9, 27, 5.},
              "Instant", "Gregorian", -6.]]]],Selectable->False],
      DefaultBaseStyle->"ImageGraphics",ImageSizeRaw->{38, 29},
      PlotRange->{{0, 38}, {0, 29}}]\), \!\(\*GraphicsBox[
TagBox[RasterBox[CompressedData["
1:eJzVl3tcjXkex5/OOdKILjJRKOqcbjNDq8xEd8OIXOqUqVRMKUXpelR0GdYs
s+y8xGsRk63EWJVtVEcq0oVcUjQG1WKM7K7dMUTq1Hmec777/f3OMYSE9c8+
r9f7fJ/f83s95/n8Pr/v7zYxNFa8nMcwTKIW/ohDkt0TEkLW+OhhYVFM4oqI
mPCwOTGS8IjwBIdQPj4cj1giAiTudPNbkXC2hUk8f/m1iT9z6a2/NSinmjRi
6y/wCVjmRx6tNgotLLFaVlRmuayo1EpFmVVIQQkltFBVJvXkPur4KV3yHvmf
d6yLSTj3AyNpukpjevsd5gPvRVlouxKRq+Nv8Pj8Z8u0fsGWbd5pbbeZd6kt
9lQTL67hIi+i7Ljp0gNFnyw5UOQQ/v2xj12DgktsrC3A2saCs7YSgqWlOVhZ
WYDOiBGgoaEBY0aPBguRCIQiESfCOD9jQ1pY8VH7lRW1778r/2KRNPTJLjgk
E9sPT8jcthnwUnb3/gJ97AMlq/hViUWlWDyf+pWTk6NUKJXK7u5uUCgUynnz
5tP3xFt3+qe2/vw/+Uf9Ot3Miyw/aYxttXYLW543YcI4pVA0kTUxGafMyd2I
Um5Ad08TyNlL0HGnEW7evApLly4GU1NTKC4uJtpBLpfTuHx5BGsyfrzSe8PX
GdgHdlGV9Qbk/99cYxONae3/YJxWxGwi7V23IYOVyznofHQHunp6oedRCsge
GMHje9ao0RqWBI4CwRABHDr0HfT19VHQtn6Q6zMPD+rf5zv3zl57jfr3pn7x
I6UnxkWUVk7yiI7OFQnNYFdWBgfQBjLZGWC5Vuh7HInaDFGbELUJYbGfDv1m
QcHBfn49uTo6OqC9vR0CAwM5zEOl91ebY5YVl0+KPnFaN77hIvn2q/1TtyH9
+j8Zl5jk35NvpaQmcwpsclfnepDdfx/1WCJCkHWaQ2+nELWZozYL1KZHx0Bu
7l549OgRhVwcx9Ho6+tL68vLy6mH0x0dlQyWA77d57G6uZVRz00Dzl/xZ1qY
5WXHx4UUSe3nxIT8xcZ6CGRmhnMc2wZdD1ZB9z1D6P5VhJihPqLNHLWZoTYR
BAXoAo/HQE5ONnR2dqK2hy9o4/F4UFFRQcvTpk/nSNtfR1tMXaMg5fJ1ZqZk
NfUrNcVAAWAJIENf5ATsO7lIBSsC7rGQ6qPaQAQ+Xqo+zd+fT32RyWT9tM2b
N4/WS6VSWv9G2mrPD0luaePPTExaz8e584slBmxz0wQ4VW0CZ2pVnCXUmUBD
jQnc/vtE2q9dv5iBErWuTTIAuylDYfv2dVBXVwM//XSD5hzRSPRJJBKYbDsZ
6uvrafmJNv/duXMlF67ietMoGDDPMB8zbv6LcYlLWqOew9hn57Pn2f6NPhBf
ezuxf++r+hfAAuZ6DKP1O3bshFddbm5uVFtwfoFzamvHgHlG1u3wIxVmi3MO
enrGxe93cvoEnJwdOCcnB6D3v+EALi4fkzr440YLqKsdC7daJ4C8S0j7VoH9
LYk3AHs7Ldj4hwQ4UVUFlRXlUHvyJNScrIaaahV1NTVgO3mSgq/BwOyU9PTg
nO88VxyrNcS5S/DsfPckzz5LSU8k7YiNi6btUgAZZ53Iw35R9Rxg5cpI6s+e
nUY034g24h/0Yl6CFfgFaA3o+csIzC+cntbW8dIx4JG6LponEPStivXplcur
cKw1wOOeu0gHckcd70LnwwYg9VErPWGIQANydo+h4/Thv81o/p2vGwfHq8bC
KrEeuBtpg/tYbXA1ehGX0e+BM+JipM25jhnGea1NT/Pbk7cgqqpeX7WfatKg
2n68wcxKSpYQ/XFRw7Hduvi99erMID71qCNZQdNofWSELm1v1i5Dmmd9XUKa
fx5zVPmW54SaV+CaEWIBsMxyYEKRcCv4SKDyLzj3oIOk+RoZtzwydpMutjI+
mX8Wmzm5VYfE2LdLpaO4w0VBiuIjf4MjJfugtHQ/grEMy4f94Kh0JKyJ0oO5
04ZAed4ogPumcKbSGKSlxhDtqQtzTLRh09RRUDbTGA65joECN6MBOeiqii7O
DhfMXWdULTtcZpHY+CNZnzSergdknN5lHKNU89tgZK54D6DFAGRSHK/1+jDX
TkCfFzlj/sV9AAvHD3/dXFPQfNtf5JjaevulaxfpW8mFKzyvLZlBNrM9jhnb
2LQJNDW5D821ON8ZWuDtrAViFy3wcx8Kvm6aIN00HNgafeg+qg/KupGwLWoY
LJqhCVvcRkIh+rXKRg/EpsPBy2Q46tR+gQWIN9YZamuyAoGAW5ydP5N8f6A5
GH1kyLr75a3/MO4xsV+T9mwOHwpwC/utyYD6BOdHApxCqvVBXqEPbKUqQjU+
u2QAs6aq/NtH8i3aBnMK8y3c8kXCkEgrmKajHqfZ+2avVuXZK9cuSeMVvteW
rUtsPBeWhIVOvpaXocPuTdGVZyfpsM179JQ9qOUx9qWs/CldZRir9OGbiGEQ
OGsobHAbqch1MWZ3OY5hsxyNXkq2sxH76Sy309aeC0rwvPGROs94g+yT6Llo
3c/3mN8tidz6bH5sCRMAXEH/6tGnhpfQaEB9DprxevOa394Dn5J9z7P7oMEg
/mE70L/MYFsv70I7H5+CKYv8C6PCP2zPXjuCzUrUle+W6LCEPepI2BGvK89K
HsF+HjStcYqvf+EUL+8iWy+fQhXiwqf3PodsF4oLv/jr97bxZ1v4r9wjDeAf
9i+T/MN1huwV1t++x1gtDPj2dfyYsfar0C/R99U4P6Xg+8+TrI5kvXyTvW9/
fRd46CF/Vc05TTwD8xds+lOgvZ9/1tSAwJ32/gFZz0OfY73/nlyXhHOX6Xvk
/YF4V2dC6iOeUckap+LGAPfX6Vn+bf14a3311EfBYAw23v7f+S/qgX5p
"], {{0,
        29}, {39, 0}}, {0, 255},ColorFunction->RGBColor],
       BoxForm`ImageTag[
       "Byte", ColorSpace -> "RGB", Interleaving -> True,
        MetaInformation -> Association[
         "Exif" -> Association[
           "Software" -> "Created with the Wolfram Language : \
www.wolfram.com"],
          "Comments" -> Association[
           "Software" -> "Created with the Wolfram Language : \
www.wolfram.com",
            "Creation Time" -> DateObject[{2017, 7, 25, 9, 27, 5.},
              "Instant", "Gregorian", -6.]]]],Selectable->False],
      DefaultBaseStyle->"ImageGraphics",ImageSizeRaw->{39, 29},
      PlotRange->{{0, 39}, {0, 29}}]\), \!\(\*GraphicsBox[
TagBox[RasterBox[CompressedData["
1:eJzdWGtUVNcVvndmgJHnvEDRMMwLTWOa+ADUNjaadq20q/2RxCCggEWjSJTX
IDO8BFHACGIl2qw2iY225k+X/7qSFVtrVB4COiiICggioMh7kPc87t3d5zAY
FEVMTVZXz1rf7Hse95zvfGefc/Yd9eaE97YJGIZJFuPPe9HGtXp9dNo6CWZC
4pNjY+K3fvCb+F1bY7bqV24WYqES8ROECJFYVv1/jYRSE5tQcnnWSMT2PyrH
UhOTXFnLpJhuPBG7nlCmx/Y/OE/khdox8RcuiVKq65lfGjKSlcuDKlXBq8qV
gcGVU+GH5cT6B66oVK3A+uXBlb8yZO4yXKkn7wt/KH76ihomuaqOSbp4lc1s
aGdeWxf6Z3RpmC1efTfkWMbNVgHOU/Si9YwvuSw0XG1k1iYZMnwX//Sqculy
0/zXllw17EnvrqgstZ8v+dpeWv6N/VzJV/bKqjJ75KZwu0AotEdERtpLy8rt
Z86eRVtmN+7J6Z73yuLGtQm7DhixP+xX8IL0I/4uSr/Rwrz+fugXU3UpLMiB
iTSIGHVYgIzMXbQ+MzMTpqbi4sO0fOm60FNpdc3OuOYu/62eyE1orLnFrE1M
yVEELLqRkZfVXVNj4iovn7FXVV/i2u/s5scGVsODnrfBbv81FH60ChYvXgy5
uTlQXV0Nra2tWG4Hm81G7b2ODr6mppbbnZdnlqm1d36xIzHfWNNIx/ke/Og5
EX+hyjm1tkkUFB5xgsz/D4fzHIp001/Okglj/e4w3KPEnB8k7nSjOhUU7IeZ
0sfFxTxptywk/ARqIEI9nb+HfoLUa03MmzsT8r381M1Ze7V99fUqrr15Ker2
FoyY34RR81swZl4K4wNaGO7V4ciLwKD3AYFAAHv3ZsPIyAiYzWbKiWhI0vHj
x0Gn04HBaOQbGhs5Y/aefqm/qnlNnH4/0fN59nvcuQpxiummOHhD2EkW53v4
oDdPOIyb/ZHXAuT1Ej4Tq0LokKMGGQRASpICWJaBnJzdMDw8DH19fZQbWWuS
ioqKqM7Jej3N5+/Pp3oGhUeeSK1rpmfaM/cvtiH+tzp2x0FP3wXtOfvUAy0t
Gq6jRY36aWG0X4ecAqZA59BxgmNygpxyyMnJhvHx8Yc6TnI8fHhiz+iRI8dx
sC8vz8oKBNyKqM2fpV6bPUfSNjB8w99IX0UHvDmAhchNg9CihtPxkCMfAOkG
Bbi6ssgxDbq7u6Gz8z7lYrFYgOd5OHLkCIjFYjAaU2l+X26ujYyzIjL6mLG2
iY0/X+U0O45NTHBk1F9YluWKCuZZiT5jZg3Yh3XTYB1Ejg6ulgdauH9HDffu
qnHNlSCXz4X09DSwWq0wNDREdSRcu7q6YHBw4owqKCykHFdu2vJp+s079P5/
JkecB85HEBwReZz41b4cH9sArue922roatV8hzY1dCKfgU7Nd3pSS9Z8IWQY
ZeDsxMCHH0Yj53vQ3NwEvT09YO7vh6HBB/S5v68XsrKzbcTfg0I3fplUZvLd
8a8SGfIQzHRmkrs4o76NWRIW9TmZn4uYtXl6MODh/iikEhbc3AS4lxSU0xj6
AlnzSb49dzXIRwu5e+eDu5cUvGQScPP0AlcPL5jj7oHWE8slIHQRU/9kxXPG
hB6eI0HR245SPZ/CL6n8ChN7+rz3zrMV/j+LDP37XB8hePtIbDKZD8hkCoS3
w/qAt8KN8szdI4cu1LKnXU3XetJnSd7cp4X8TClIhAzIXRiQiBj6TOF4ljmx
oBDjOHNEnBzLVr4fciruXJUy9vQFb8Jnmh/WNjGrojcXO81xtezPn28ZfOAF
XR350D+A62JuRDRT24f5vm4D+tlcMCQrwMmZhUMF3lTPoV4ttekGKYjEuH+X
SsEaFQCdoTiPcO0j6CU2TAvdYRq4j/XYjs8L9rUKRCJ+RcSmo2RfTN3nk/s5
aGPEJ0T7gwUL8dBdBuOjn4EdLGDnOxHdYOPug41Hv7+XAR13FZCaJAdfGQuf
FMpxQ2ih7aY/tKGvpmyTwDwXESS/KoWO9Wq4/o4/NLyrmoZ6hyX1d0PUkLVK
Oezm7dP3xgfbC4y1t57IMTji939kWJYvPLTXxvODMDzaBuPWTkQPwkwtSUZj
HPWjA9s9YPy8DAb+IQGolIMhdMK/9i1HzjEvQ/YSGc0LGHbGmE0oFNqcBSwE
hm08ibGxZ9y3Fe5POxeDI6OPkjO1sCjPynEWGBpphzFLF4yO1cO4pQpa28qh
oaEOUvURoPEVwLEUT4CLMhj5CjmWyuCjLXNAMx/vwpVSuB2ugd3IUeXuBBqE
v7vIAadHrNrDCeSuzlaGFXDLNkR9nna95YkxG+VYd5sJDIv41BE78FNjB95K
YrD56GcT9/GhHW5gR06jX6O/nUb8Uwo2BMlz5TJIWjehZ9IryH3LQhjeiHsp
Eu8kxJgD5HkIy0n9geUKeicGrg/7ErXCWObStLOc3OUk5lwTn5wl1wbcyMzP
7r1WV81dMp3hqq+auKqKGK7umoKLjpJwDDnbY115HrmMICfLN4jTE5Zw5JH7
wRhXeFklhJRgCX/tHRVX9lsld/F301GK5aQ+bbWuR65beGNNXFIejX1niC1Q
Y6rn6yHhJ2fyn6IYZwCTHPgzUoBzskfxLeLfiCtyOLjNeVbfEEvWbzhBxo2f
RRxJ9cSY4ufb4wolC/zaZf6qFomfsn0Scn8/tKr2rG0+Q02npNz1L6Rc/V8l
XP0JyYR1gJST+t1bfQZJ+4n3lNNA+3/Jr/2N2LgCMu7zxGbkmyih5JIY48hH
EHeu0t1Qc0u8bH3YMXo/PEWXyfJl68P/hGPT9x7v6yEu4DilpmfGEk+7dxIf
A/mOJ+fW6jh9Nsb6zQrdoga5Rtf8OEg5qcd2maQ9/f5/Qn8Ej98nzwd6r08H
3vfYrwAhSro4A0h9+cP4YAb8yP9d/O/hGfpUvzB9/gOXN1lD
"], {{0, 30}, {41,
        0}}, {0, 255},ColorFunction->RGBColor],BoxForm`ImageTag[
       "Byte", ColorSpace -> "RGB", Interleaving -> True,
        MetaInformation -> Association[
         "Exif" -> Association[
           "Software" -> "Created with the Wolfram Language : \
www.wolfram.com"],
          "Comments" -> Association[
           "Software" -> "Created with the Wolfram Language : \
www.wolfram.com",
            "Creation Time" -> DateObject[{2017, 7, 25, 9, 27, 5.},
              "Instant", "Gregorian", -6.]]]],Selectable->False],
      DefaultBaseStyle->"ImageGraphics",ImageSizeRaw->{41, 30},
      PlotRange->{{0, 41}, {0, 30}}]\), \!\(\*GraphicsBox[
TagBox[RasterBox[CompressedData["
1:eJzVl3tcjXkex5/OOdKILjJRKOqcbjNDq8xEd8OIXOqUqVRMKUXpelR0GdYs
s+y8xGsRk63EWJVtVEcq0oVcUjQG1WKM7K7dMUTq1Hmec777/f3OMYSE9c8+
r9f7fJ/f83s95/n8Pr/v7zYxNFa8nMcwTKIW/ohDkt0TEkLW+OhhYVFM4oqI
mPCwOTGS8IjwBIdQPj4cj1giAiTudPNbkXC2hUk8f/m1iT9z6a2/NSinmjRi
6y/wCVjmRx6tNgotLLFaVlRmuayo1EpFmVVIQQkltFBVJvXkPur4KV3yHvmf
d6yLSTj3AyNpukpjevsd5gPvRVlouxKRq+Nv8Pj8Z8u0fsGWbd5pbbeZd6kt
9lQTL67hIi+i7Ljp0gNFnyw5UOQQ/v2xj12DgktsrC3A2saCs7YSgqWlOVhZ
WYDOiBGgoaEBY0aPBguRCIQiESfCOD9jQ1pY8VH7lRW1778r/2KRNPTJLjgk
E9sPT8jcthnwUnb3/gJ97AMlq/hViUWlWDyf+pWTk6NUKJXK7u5uUCgUynnz
5tP3xFt3+qe2/vw/+Uf9Ot3Miyw/aYxttXYLW543YcI4pVA0kTUxGafMyd2I
Um5Ad08TyNlL0HGnEW7evApLly4GU1NTKC4uJtpBLpfTuHx5BGsyfrzSe8PX
GdgHdlGV9Qbk/99cYxONae3/YJxWxGwi7V23IYOVyznofHQHunp6oedRCsge
GMHje9ao0RqWBI4CwRABHDr0HfT19VHQtn6Q6zMPD+rf5zv3zl57jfr3pn7x
I6UnxkWUVk7yiI7OFQnNYFdWBgfQBjLZGWC5Vuh7HInaDFGbELUJYbGfDv1m
QcHBfn49uTo6OqC9vR0CAwM5zEOl91ebY5YVl0+KPnFaN77hIvn2q/1TtyH9
+j8Zl5jk35NvpaQmcwpsclfnepDdfx/1WCJCkHWaQ2+nELWZozYL1KZHx0Bu
7l549OgRhVwcx9Ho6+tL68vLy6mH0x0dlQyWA77d57G6uZVRz00Dzl/xZ1qY
5WXHx4UUSe3nxIT8xcZ6CGRmhnMc2wZdD1ZB9z1D6P5VhJihPqLNHLWZoTYR
BAXoAo/HQE5ONnR2dqK2hy9o4/F4UFFRQcvTpk/nSNtfR1tMXaMg5fJ1ZqZk
NfUrNcVAAWAJIENf5ATsO7lIBSsC7rGQ6qPaQAQ+Xqo+zd+fT32RyWT9tM2b
N4/WS6VSWv9G2mrPD0luaePPTExaz8e584slBmxz0wQ4VW0CZ2pVnCXUmUBD
jQnc/vtE2q9dv5iBErWuTTIAuylDYfv2dVBXVwM//XSD5hzRSPRJJBKYbDsZ
6uvrafmJNv/duXMlF67ietMoGDDPMB8zbv6LcYlLWqOew9hn57Pn2f6NPhBf
ezuxf++r+hfAAuZ6DKP1O3bshFddbm5uVFtwfoFzamvHgHlG1u3wIxVmi3MO
enrGxe93cvoEnJwdOCcnB6D3v+EALi4fkzr440YLqKsdC7daJ4C8S0j7VoH9
LYk3AHs7Ldj4hwQ4UVUFlRXlUHvyJNScrIaaahV1NTVgO3mSgq/BwOyU9PTg
nO88VxyrNcS5S/DsfPckzz5LSU8k7YiNi6btUgAZZ53Iw35R9Rxg5cpI6s+e
nUY034g24h/0Yl6CFfgFaA3o+csIzC+cntbW8dIx4JG6LponEPStivXplcur
cKw1wOOeu0gHckcd70LnwwYg9VErPWGIQANydo+h4/Thv81o/p2vGwfHq8bC
KrEeuBtpg/tYbXA1ehGX0e+BM+JipM25jhnGea1NT/Pbk7cgqqpeX7WfatKg
2n68wcxKSpYQ/XFRw7Hduvi99erMID71qCNZQdNofWSELm1v1i5Dmmd9XUKa
fx5zVPmW54SaV+CaEWIBsMxyYEKRcCv4SKDyLzj3oIOk+RoZtzwydpMutjI+
mX8Wmzm5VYfE2LdLpaO4w0VBiuIjf4MjJfugtHQ/grEMy4f94Kh0JKyJ0oO5
04ZAed4ogPumcKbSGKSlxhDtqQtzTLRh09RRUDbTGA65joECN6MBOeiqii7O
DhfMXWdULTtcZpHY+CNZnzSergdknN5lHKNU89tgZK54D6DFAGRSHK/1+jDX
TkCfFzlj/sV9AAvHD3/dXFPQfNtf5JjaevulaxfpW8mFKzyvLZlBNrM9jhnb
2LQJNDW5D821ON8ZWuDtrAViFy3wcx8Kvm6aIN00HNgafeg+qg/KupGwLWoY
LJqhCVvcRkIh+rXKRg/EpsPBy2Q46tR+gQWIN9YZamuyAoGAW5ydP5N8f6A5
GH1kyLr75a3/MO4xsV+T9mwOHwpwC/utyYD6BOdHApxCqvVBXqEPbKUqQjU+
u2QAs6aq/NtH8i3aBnMK8y3c8kXCkEgrmKajHqfZ+2avVuXZK9cuSeMVvteW
rUtsPBeWhIVOvpaXocPuTdGVZyfpsM179JQ9qOUx9qWs/CldZRir9OGbiGEQ
OGsobHAbqch1MWZ3OY5hsxyNXkq2sxH76Sy309aeC0rwvPGROs94g+yT6Llo
3c/3mN8tidz6bH5sCRMAXEH/6tGnhpfQaEB9DprxevOa394Dn5J9z7P7oMEg
/mE70L/MYFsv70I7H5+CKYv8C6PCP2zPXjuCzUrUle+W6LCEPepI2BGvK89K
HsF+HjStcYqvf+EUL+8iWy+fQhXiwqf3PodsF4oLv/jr97bxZ1v4r9wjDeAf
9i+T/MN1huwV1t++x1gtDPj2dfyYsfar0C/R99U4P6Xg+8+TrI5kvXyTvW9/
fRd46CF/Vc05TTwD8xds+lOgvZ9/1tSAwJ32/gFZz0OfY73/nlyXhHOX6Xvk
/YF4V2dC6iOeUckap+LGAPfX6Vn+bf14a3311EfBYAw23v7f+S/qgX5p
"], {{0,
        29}, {39, 0}}, {0, 255},ColorFunction->RGBColor],
       BoxForm`ImageTag[
       "Byte", ColorSpace -> "RGB", Interleaving -> True,
        MetaInformation -> Association[
         "Exif" -> Association[
           "Software" -> "Created with the Wolfram Language : \
www.wolfram.com"],
          "Comments" -> Association[
           "Software" -> "Created with the Wolfram Language : \
www.wolfram.com",
            "Creation Time" -> DateObject[{2017, 7, 25, 9, 27, 5.},
              "Instant", "Gregorian", -6.]]]],Selectable->False],
      DefaultBaseStyle->"ImageGraphics",ImageSizeRaw->{39, 29},
      PlotRange->{{0, 39}, {0, 29}}]\)};
ListAnimate[animationFrames, AnimationRate -> 2]

The ground is unique in that the image never changes. To create the illusion of continuous movement, you can reset its position at a certain point, exactly like I do with the obstacles:

Input 56

SetAttributes[updateGroundPosition, HoldFirst];
updateGroundPosition[{groundPos_}, groundResetValue_, vel_,
  ups_] := (
  groundPos += vel/ups;
  If[groundPos < -groundResetValue, groundPos = 0];
  groundPos)

For continuously updating sprites, like the bird, the Clock function is often sufficient to cycle through the animation frames at a fixed rate:

Input 58

DynamicModule[{vPos = 10, hPos = 3, vel = 0, ups = 30, gravity = -50,
  kick = 2, previousKeyState = False, worldEdge = 10, imageSize = 250,
   groundPos = 0, groundResetValue = 0.71},

 Framed[Graphics[{
    Inset[city, {0, -0.6}, Scaled[{0, 0}], 10],
    Inset[Dynamic[animationFrames[[Clock[{1, 4, 1}, 0.5]]]],
     {hPos,
      Dynamic[
       updateSpikeyPosition[{vPos, vel, previousKeyState},
        CurrentValue["ControlKey"], kick, gravity, ups]
       ]}, Center, 1.2],
    Inset[
     ground, {Dynamic[
       updateGroundPosition[{groundPos}, groundResetValue, -0.7,
        ups]], -0.3}, Scaled[{0, 1}], 12]
    },
   PlotRange -> {{0, worldEdge}, {-2, 12}}, ImageSize -> imageSize,
   Background ->
    RGBColor[0.44313725490196076`, 0.7725490196078432,
     0.8117647058823529]
   ], FrameMargins -> -1], SaveDefinitions -> True
 ]

Output 58 animation

The worst case is noncontinuous movement, such as movement that is triggered by pressing a button. I still want the dynamic expression to update as fast as possible such that our position updates like normal, but I don't want the animation frames to cycle at the same rate. I tend to use an instance of Mod to introduce a delay into the update of the frame index:

Input 59

DynamicModule[{animationCounter = 0, animationDelay = 10,
  frameCounter = 1},
 Dynamic[
  If[CurrentValue["ControlKey"],
   animationCounter++;
   If[Mod[animationCounter, animationDelay] == 0,
    animationCounter = 0; frameCounter++];
   If[frameCounter == 5, frameCounter = 1]];
  animationFrames[[frameCounter]]
  ], SaveDefinitions -> True
 ]


If you'd like to play around with the code you read about today, you can download this post as a Wolfram Notebook.

]]>
http://blog.wolfram.com/2017/12/28/spikey-bird-creating-a-flappy-bird-mod-in-the-wolfram-language/feed/ 0
Computational Gastronomy: Using the Wolfram Language to Prepare a Sumptuous Holiday Feast http://blog.wolfram.com/2017/12/22/computational-gastronomy-using-the-wolfram-language-to-prepare-a-sumptuous-holiday-feast/ http://blog.wolfram.com/2017/12/22/computational-gastronomy-using-the-wolfram-language-to-prepare-a-sumptuous-holiday-feast/#comments Fri, 22 Dec 2017 15:21:37 +0000 Micah Lindley http://blog.internal.wolfram.com/?p=40062 Plated meal restyled

In recent years there’s been a growing interest in the intersection of food and technology. However, many of the new technologies used in the kitchen are cooking tools and devices such as immersion circulators, silicone steam baskets and pressure ovens. Here at Wolfram, our approach has been a bit different, with a focus on providing tools that can query for, organize, visualize and compute data about food, cooking and nutrition.

Last Christmas I went home to Tucson, Arizona, to spend time with my family over the holidays. Because I studied the culinary arts and food science, I was quickly enlisted to cook Christmas dinner. There were going to be a lot of us at my parents’ house, so I was aware this would be no small task. But I curate food and nutrition data for Wolfram|Alpha, so I knew the Wolfram technology stack had some excellent resources for pulling off this big meal without a hitch.

Building a Christmas Dinner Survey

Our family has diverse tastes, and we had at least one vegan in the bunch last year. I wanted to make sure that everyone felt included and was served a meal they could really enjoy. So with the help of one my Wolfram colleagues, I created a Christmas dinner survey using the Wolfram Cloud and Wolfram Data Drop.

Setting Up a Databin

The Wolfram Data Drop is a great way to collect and store data from IoT (Internet of Things) devices. Whether you’re collecting weather data from your desk or mileage data from your car, Data Drop provides a great platform to collect data and store it safely in the Wolfram Cloud, and it allows you to use tools in the Wolfram Language to analyze the data at your leisure. The Wolfram Data Drop can also be used to collect data from people through web forms built in the Wolfram Language.

The first step in using the Wolfram Data Drop is to create a new databin where the data will be stored. The code shown here demonstrates how easy this is and includes options for naming the databin, specifying the administrator and setting permissions.

foodSurveyDatabin code

foodSurveyDatabin = CreateDatabin[
  <|
   	"Name" -> "Christmas Dinner Survey 2017",
   	"Administrator" -> "micahl@wolfram.com",
   	Permissions -> "Public"
   |>
  ]

Creating a Web Form

Making web forms in the Wolfram Language is one of my personal favorite features introduced in the last few years. While creating web forms may not generate headlines in the way functions like Classify or ImageRestyle might, the practical applications of web forms in a variety of contexts are nearly limitless—and they are a great introduction to writing code and computational thinking because the web forms are easy to design, build, test and tweak, even for people new to the Wolfram Language and programming. Using web forms is a great way to collect data because the forms are easy to fill out. We can also deploy them to the web so we can access them from desktop or mobile platforms. They also store the interpreted data in a uniform structure, making the later steps of data analysis and visualization much, much easier.

Using FormFunction, DatabinAdd, and CloudDeploy, we can build a custom survey that collects and interprets data. This is then stored using WDF (Wolfram Data Framework), which utilizes the Wolfram Knowledgebase and knows about Entities (such as cities and foods), as well as quantities, images and networks.

Data Drop screenshot

Christmas dinner survey screen shot

(Here’s a downloadable notebook with the code to build this web form.)

Sending Out Emails Programmatically

After I built the survey, I needed an easy way to invite my family members to respond to it. Using tools available in the Wolfram Language, I was able to quickly design a form email that I could deploy in just a few lines of code that would also address each family member individually. I constructed an Association with the names and email addresses of my family members and wrote a brief email asking the recipient to fill out the Christmas dinner survey. Then I used SendMail to slot in the name, email address, email body and survey hyperlink, and sent the emails en masse to everyone invited to Christmas dinner.

emailList codeemailBody code

emailBody =
  "We're looking forward to having you over for Christmas dinner! As \
we'll be hosting a decent-sized crowd, I've created a brief survey \
where you can fill out any dietary preferences, restrictions, \
allergies, or recommendations. Here's the link: \
https://www.wolframcloud.com/";
hyperlink = Hyperlink[
   "Christmas Dinner Survey 2017",
   "https://www.wolframcloud.com/objects/micahl20160425165842Rywd/\
Christmas2017/survey"
   ];
SendMail[
   <|
    "To" -> #EmailAddress,
    "Subject" -> "Christmas Dinner Survey 2017",
    "Body" -> StringTemplate["Dear ``,\n\n``"][#Name, emailBody],
    "Signature" -> "Thanks,\nMicah"
    |>
   ] & /@ emailList

A European Holiday Food Map

Gathering food preferences from my family was just the beginning. I always want to wow the people I cook for, so I also needed some inspiration for enhancing the dishes I’d serve. Using tools in the Wolfram Language, it’s easy to build visual aids to assist with culinary experimentation, which often helps get my creative juices flowing. I’ve personally put loads of food images into Wolfram|Alpha, and I know that the Wolfram Language has access to the treasure trove of content in Wolfram|Alpha. So I thought I’d play around with this resource.

Data visualizations come in many forms these days, and the Wolfram Language provides numerous built-in functions to create them, such as WordCloud and ImageCollage. But I thought I’d take a holiday-food visualization one step further…

I was thinking about how particular holiday dishes and preparations are associated with the nations where they originated. Certain ingredients may be revered or taboo, depending on the local culture and religion. Geography also plays an important role due to the environmental needs of source ingredients. For example, rye and oats are the grains of choice in Northern Europe because wheat doesn’t grow well in that colder climate. I decided using a map with images of traditional holiday dishes could lead to the “aha” moment I was looking for.

To get started, I curated image URLs of holiday dishes from European countries and gathered them in an Association. Associations are a great way to store data because they are very fast and have labeled Key/value pairs, which are easy to understand and query. Next, I used Put to create a package file that stores Wolfram Language expressions as a separate file that allows for better organization of data and code. Then, using CloudObject and CopyFile, I uploaded the package file to the Wolfram Cloud, setting SetPermisions to "Public", which allows anyone to access the data. Finally, I used a simple CloudGet on the CloudObject to download the data from the Wolfram Cloud directly into a notebook.

The next steps in the process take the image data from the Wolfram Cloud and visualize the images using geography data built into the Wolfram Language. Using functions such as GeoGraphics and GeoStyling, I was able to construct a map of images of traditional holiday foods displayed over their home nations. The Tooltip function provides a clean and nifty way to display the name of each dish without cluttering the map with textual labels or unsightly keys. ImageAssemble tiles the images into a collage, so the dish in question is easier to see when displayed on its country of origin. And EdgeForm defines the borders of each country, making the image easier to recognize as a map of Europe.

To collect the images I searched Creative Commons. From there, I simply grabbed the image file name, author attribution, dish name and country and placed them in a List of Associations.

Creating this map requires a bit of curation. I assembled the images I needed in this package file you can download. Just make sure you place it in the same file directory as the target notebook.

euroHolidayFoodsCloudObject code

SetDirectory[NotebookDirectory[]];
euroHolidayFoodsCloudObject =
  CloudObject["EuropeanHolidayFoodMap/EuropeanChristmasDishImages.m"];
CopyFile["EuropeanChristmasDishImages.m", euroHolidayFoodsCloudObject];
SetPermissions[euroHolidayFoodsCloudObject, "Public"];
euroHolidayFoods = CloudGet[euroHolidayFoodsCloudObject]

(This output is only a sample set with the first three entries. The package file I mentioned earlier has the complete set.)

The map is a slick bit of code that uses GeoGraphics to tile each image over its source country. Tooltip allows you to hover the cursor over each country to see a pop-up of the associated food.

GeoGraphics Europe map with holiday foods

GeoGraphics[
 {
  With[
     {image = Import[#ImageURL]},
     {
      GeoStyling[
       {
        "Image",
        ImageAssemble[
         ConstantArray[
          Replace[
           ImageTrim[
            image,
            {{.2, .2}, {.8, .8}},
            DataRange -> {{0, 1}, {0, 1}}
            ],

           i_Image /; (ImageDimensions[i][[1]] > 1000) :>
            ImageResize[i, 500]
           ],
          {3, 3}
          ]
         ]
        }
       ],
      EdgeForm[Gray],
      Tooltip[Polygon[#Country],
       Framed[Row@{#DishName, "   ", image}, FrameStyle -> Gray]]
      }
     ]
    & /@ euroHolidayFoods
  },
 GeoRange -> \!\(\*
NamespaceBox["LinguisticAssistant",
DynamicModuleBox[{Typeset`query$$ = "europe", Typeset`boxes$$ =
      TemplateBox[{"\"Europe\"",
RowBox[{"Entity", "[",
RowBox[{"\"GeographicRegion\"", ",", "\"Europe\""}], "]"}],
        "\"Entity[\\\"GeographicRegion\\\", \\\"Europe\\\"]\"",
        "\"geographic region\""}, "Entity"],
      Typeset`allassumptions$$ = {{
       "type" -> "Clash", "word" -> "europe",
        "template" -> "Assuming \"${word}\" is ${desc1}. Use as \
${desc2} instead", "count" -> "3",
        "Values" -> {{
          "name" -> "GeographicRegion", "desc" -> "a continent",
           "input" -> "*C.europe-_*GeographicRegion-"}, {
          "name" -> "CountryClass", "desc" -> "a class of countries",
           "input" -> "*C.europe-_*CountryClass-"}, {
          "name" -> "Word", "desc" -> "a word",
           "input" -> "*C.europe-_*Word-"}}}},
      Typeset`assumptions$$ = {}, Typeset`open$$ = {1, 2},
      Typeset`querystate$$ = {
      "Online" -> True, "Allowed" -> True,
       "mparse.jsp" -> 3.091041`6.941649759140215, "Messages" -> {}}},
DynamicBox[ToBoxes[
AlphaIntegration`LinguisticAssistantBoxes["", 4, Automatic,
Dynamic[Typeset`query$$],
Dynamic[Typeset`boxes$$],
Dynamic[Typeset`allassumptions$$],
Dynamic[Typeset`assumptions$$],
Dynamic[Typeset`open$$],
Dynamic[Typeset`querystate$$]], StandardForm],
ImageSizeCache->{217., {7., 17.}},
TrackedSymbols:>{
        Typeset`query$$, Typeset`boxes$$, Typeset`allassumptions$$,
         Typeset`assumptions$$, Typeset`open$$, Typeset`querystate$$}],
DynamicModuleValues:>{},
UndoTrackedVariables:>{Typeset`open$$}],
BaseStyle->{"Deploy"},
DeleteWithContents->True,
Editable->False,
SelectWithContents->True]\),
 ImageSize -> Large,
 GeoRangePadding -> {{Quantity[-50, "Kilometers"],
    Quantity[-600, "Kilometers"]}, {Quantity[-250,
     "Kilometers"], -Quantity[575, "Kilometers"]}}
 ]

Europe holiday foods map

Computational Solutions to Culinary Conundrums

My Christmas dinner project was well on its way. I had dish requests. I had some ideas for sprucing them up with some unusual ingredients and preparation methods from “the old countries.” But would I have everything I needed to make it all happen?

Running out of ingredients while cooking a meal for a large group is one of the most discouraging and frustrating experiences for home cooks. Cooking during the holidays can be especially challenging because many grocery stores and markets are closed or have limited hours. Plus, when cooking a large meal, it can be difficult to find the time to duck out and purchase the missing ingredients due to the various tasks that must be carefully attended throughout meal preparation. Fortunately, the Wolfram Language has you covered.

My brother Caleb requested carrot purée as a side dish for Christmas dinner. I was eager to cater to my brother’s request, but I also wanted to add a creative twist to the dish—however, I needed a bit of assistance. Despite years of studying food, I couldn’t remember all the different colors carrots can be. But the Wolfram Language knows about thousands of foods, including carrots. In a couple of lines of code, it was easy to access data including an image of the food and information about interior and exterior colors. I found data about price look-up codes (commonly referred to as PLUs), allowing for a quick confirmation that the gnarled root vegetable in my hand was a carrot and not a parsnip.

Carrot comparisons screen shot

Vegetable PLUs screen shot

Before I ran to the grocery store, I wanted a backup plan in case they didn’t have any non-orange carrots. Fortunately, a simple query in the Wolfram Language can provide carefully curated ingredient substitutions. With some extra code, the ingredients are visualized in a grid, which helps to digest the data more easily. The list is also ordered so the first ingredient (or set of ingredients) listed is considered the best substitution and the second ingredient listed is the second-best substitute. As someone who taught cooking classes for several years, I know that one of the most common meal-killers rears its ugly head when people are missing that one crucial ingredient. But with the help of the Wolfram Language, it’s like having a professional chef with you in the kitchen to suggest substitutions and much more, such as offering proportion calculations, providing nutrition information, giving you descriptions of new ingredients… the list goes on!

visualizeReplacements carrot output

(Here’s a downloadable notebook with the code to build the visualizeReplacements function.)

Keep Wolfram in Your Kitchen

Our big family Christmas dinner last year was a tremendous hit. Whenever I cook at my parents’ house I always encounter a few curve balls, so I appreciated the help I got from the Wolfram tech stack. My family wanted me to do it again this year, but I decided to stay in Illinois, eat some takeout Chinese food and watch kung fu movies instead. However, if you have an ambitious holiday cooking project ahead of you, I encourage you to experiment in the kitchen with the Wolfram Language.

A great place to start exploring computational gastronomy is the Wolfram|Alpha Examples page for food and nutrition. There you can see the wide variety of Wolfram|Alpha query fields on cooking, ingredients and other food-related data, as well as food-themed Wolfram|Alpha blog posts. If the Wolfram|Alpha app isn’t on your smartphone, it should be… especially when you’re in the thick of meal prep and could use some data or number crunching! Happy computational cooking!

Appendix: Creating the Lead Image

My dad studied art in college, so growing up, my parents’ house was always full of art made by my dad and friends of his from college. In addition, I always try to take pictures of the dishes I’ve prepared when I cook a nice meal for friends and family. Since this blog is about cooking and family, I thought, “Why not combine these images using my favorite new Wolfram Language function, ImageRestyle?” In one quick line of code, any image can be rendered in the style of another image or list of images. So I simply took a picture of a dish I prepared and blended it with a list containing a painting by my dad’s friend Mike and the same picture of a dish I prepared (the original image is added to keep the colors in the final image brighter) and voilà, I get an image that looks like a painting of food (and without a drop of paint on my clothes).

Here’s another dish I photographed and then restyled using the same technique and art piece:

Lead image restyle

]]>
http://blog.wolfram.com/2017/12/22/computational-gastronomy-using-the-wolfram-language-to-prepare-a-sumptuous-holiday-feast/feed/ 0
Creating Mathematical Gems in the Wolfram Language http://blog.wolfram.com/2017/12/14/creating-mathematical-gems-in-the-wolfram-language/ http://blog.wolfram.com/2017/12/14/creating-mathematical-gems-in-the-wolfram-language/#comments Thu, 14 Dec 2017 15:00:10 +0000 Michael Gammon http://blog.internal.wolfram.com/?p=39801 The Wolfram Community group dedicated to visual arts is abound with technically and aesthetically stunning contributions. Many of these posts come from prolific contributor Clayton Shonkwiler, who has racked up over 75 “staff pick” accolades. Recently I got the chance to interview him and learn more about the role of the Wolfram Language in his art and creative process. But first, I asked Wolfram Community’s staff lead, Vitaliy Kaurov, what makes Shonkwiler a standout among mathematical artists.

Stereo Vision Rise Up“Stereo Vision” and “Rise Up”

“Clay, I think, pays special attention to expressing a math concept behind the art,” Kaurov says. “It is there, like a hidden gem, but a layman will not recognize it behind the beautiful visual. So Clay’s art is a thing within a thing, and there is more to it than meets the eye. That mystery is intriguing once you know it is there. But it’s not easy to express something as abstract and complex as math in something as compact and striking as a piece of art perceivable in a few moments. This gap is bridged with help from the Wolfram Language, because it’s a very expressive, versatile medium inspiring the creative process.”

Shonkwiler is a mathematics professor at Colorado State University and an avid visual artist, specializing in Wolfram Language–generated GIF animations and static images based on nontrivial math. “I am interested in geometric models of physical systems. Currently I’m mostly focused on geometric approaches to studying random walks with topological constraints, which are used to model polymers,” he says.

In describing how he generates ideas, he says, “There are some exceptions, but there are two main starting points. Often I get it into my head that I should be able to make an animation from some interesting piece of mathematics. For example, in recent months I’ve made animations related to the Hopf fibration.”

Stay Upright
“Stay Upright”

"Stay Upright" code

DynamicModule[{n = 60, a = \[Pi]/4,
  viewpoint = {1, 1.5, 2.5}, \[Theta] = 1.19, r = 2.77, plane,
  cols = RGBColor /@ {"#f43530", "#e0e5da", "#00aabb", "#46454b"}},
 plane = NullSpace[{viewpoint}];
 Manipulate[
  Graphics[{Thickness[.003],
    Table[{Blend[cols[[;; -2]], r/\[Pi]],
      InfiniteLine[
       RotationMatrix[\[Theta]].plane.# & /@ {{Cot[r] Csc[a], 0,
          Cot[a]}, {0, Cot[r] Sec[a], -Tan[a]}}]}, {r, \[Pi]/(2 n) +
       s, \[Pi], 2 \[Pi]/n}]}, Background -> cols[[-1]],
   PlotRange -> r, ImageSize -> 540], {s, 0., 2 \[Pi]/n}]]

Like many artists, Shonkwiler draws inspiration from existing art and attempts to recreate it or improve upon it using his own process. He says, “Whether or not I actually succeed in reproducing a piece, I usually get enough of a feel for the concept to then go off in some new direction with it.”

As to the artists who inspire him, Shonkwiler says, “There’s an entire community of geometric GIF artists on social media that I find tremendously inspiring, including Charlie Deck, davidope, Saskia Freeke and especially Dave Whyte. I should also mention David Mrugala, Alberto Vacca Lepri, Justin Van Genderen and Pierre Voisin, who mostly work in still images rather than animations.” If you want to see other “math art” that has inspired Shonkwiler, check out Frank Farris, Kerry Mitchell, Henry Segerman, Craig Kaplan and Felicia Tabing.

Another artistic element in Shonkwiler’s pieces is found in the title he creates for each one. You’ll find clever descriptors, allusions to ancient literature and wordplay with mathematical concepts. He says he usually creates the title after the piece is completely done. “I post my GIFs in a bunch of places online, but Wolfram Community is usually first because I always include a description and the source code in those posts, and I like to be able to point to the source code when I post to other places. So what often happens is I’ll upload a GIF to Wolfram Community, then spend several minutes staring at the post preview, trying to come up with a title.” Although he takes title creation seriously, Shonkwiler says, “Coming up with titles is tremendously frustrating because I’m done with the piece and ready to post it and move on, but I need a title before I can do that.”

Interlock
“Interlock”

"Interlock" code

Stereo[{x1_, y1_, x2_, y2_}] := {x1/(1 - y2), y1/(1 - y2),
   x2/(1 - y2)};

With[{n = 30, m = 22, viewpoint = 5 {1, 0, 0},
  cols = RGBColor /@ {"#2292CA", "#EEEEEE", "#222831"}},
 Manipulate[
  Graphics3D[{cols[[1]],
    Table[Tube[
      Table[Stereo[
        RotationTransform[-s, {{1, 0, 0, 0}, {0, 0, 0, 1}}][
         1/Sqrt[2] {Cos[\[Theta]], Sin[\[Theta]], Cos[\[Theta] + t],
           Sin[\[Theta] + t]}]], {\[Theta], 0., 2 \[Pi],
        2 \[Pi]/n}]], {t, 0., 2 \[Pi], 2 \[Pi]/m}]},
   ViewPoint -> viewpoint, Boxed -> False, Background -> cols[[-1]],
   ImageSize -> 500, PlotRange -> 10, ViewAngle -> \[Pi]/50,
   Lighting -> {{"Point", cols[[1]], {0, -1, 0}}, {"Point",
      cols[[2]], {0, 1, 0}}, {"Ambient", RGBColor["#ff463e"],
      viewpoint}}], {s, 0, \[Pi]}]]

(This code plots the curves with fewer points so as to increase the responsiveness of the Manipulate.)

Other Wolfram Community members have complimented Shonkwiler on the layers of color he gives his geometric animations. Likewise, his use of shading often enhances the shapes within his art. But interestingly, his work usually begins monochromatically. “Usually I start in black and white when I’m working on the geometric form and trying to make the animation work properly. That stuff is usually pretty nailed down before I start thinking about colors. I’m terrible at looking at a bunch of color swatches and envisioning how they will look in an actual composition, so usually I have to try a lot of different color combinations before I find one I like.”

Shonkwiler says that the Wolfram Language makes testing out color schemes a quick process. “If you look at the code for most of my animations, you’ll find a variable called cols so that I can easily change colors just by changing that one variable.”

Magic Carpet Square Up“Magic Carpet” and “Square Up”

I asked Shonkwiler if he conceives the visual outcome before he starts his work, or if he plays with the math and code until he finds something he decides to keep. He said it could go either way, or it might be a combination. “‘Magic Carpet’ started as a modification of ‘Square Up,’ which was colored according to the z coordinate from the very earliest versions, so that’s definitely a case where I had something in my head that turned out to require some extra fiddling to implement. But often I’m just playing around until I find something that grabs me in some way, so it’s very much an exploration.”

Renewable Resources Inner Light“Renewable Resources” and “Inner Light”

Shonkwiler actually has a lot of pieces that are related to each other mathematically. Regarding the two above, “They’re both visualizations of the same Möbius transformation. A Möbius transformation of a sphere is just a map from the sphere to itself that preserves the angles everywhere. They’re important in complex analysis, algebraic geometry, hyperbolic geometry and various other places, which means there are lots of interesting ways to think about them. They come up in my research in the guise of automorphisms of the projective line and as isometries of the hyperbolic plane, so they’re often on my mind.”

“To make ‘Inner Light,’ I took a bunch of concentric circles in the plane and just started scaling the plane by more and more, so that each individual circle is getting bigger and bigger. Then I inverse-stereographically project up to the sphere, where the circles become circles of latitude and I make a tube around each one. ‘Renewable Resource’ is basically the same thing, except I just have individual points on each circle and I’m only showing half of the sphere in the final image rather than the whole sphere.”

When I asked Shonkwiler about his philosophy on the relationship between math and aesthetics, he said, “Part of becoming a mathematician is developing a very particular kind of aesthetic sense that tells you whether an argument or a theory is beautiful or ugly, but this has probably been overemphasized to the point of cliché.”

However, Shonkwiler continued to mull the question. “I do think that when you make a visualization of a piece of interesting mathematics, it is often the case that it is visually compelling on some deep level, even if not exactly beautiful in a traditional sense. That might just be confirmation bias on my part, so there’s definitely an empirical question as to whether that’s really true and, if it is, you could probably have a metaphysical or epistemological debate about why that might be. But in any case, I think it’s an interesting challenge to find those visually compelling fragments of mathematics and then to try to present them in a way that also incorporates some more traditional aesthetic considerations. That’s something I feel like I’ve gotten marginally better at over the years, but I’m definitely still learning.”

Here is Shonkwiler with one of his GIFs at MediaLive x Ello: International GIF Competition in Boulder, Colorado:

Clay at GIF competition

Check out Clayton Shonkwiler’s Wolfram Community contributions. To explore his work further, visit his blog and his website. Of course, if you have Wolfram Language–based art, post it on Wolfram Community to strike up a conversation with other art and Wolfram Language enthusiasts. It’s easy and free to sign up for a Community account.

]]>
http://blog.wolfram.com/2017/12/14/creating-mathematical-gems-in-the-wolfram-language/feed/ 0
Tracking a Descent to Savagery with the Wolfram Language: Plotting Sentiment Analysis in Lord of the Flies http://blog.wolfram.com/2017/12/07/tracking-a-descent-to-savagery-with-the-wolfram-language-plotting-sentiment-analysis-in-lord-of-the-flies/ http://blog.wolfram.com/2017/12/07/tracking-a-descent-to-savagery-with-the-wolfram-language-plotting-sentiment-analysis-in-lord-of-the-flies/#comments Thu, 07 Dec 2017 15:36:30 +0000 Jon McLoone http://blog.internal.wolfram.com/?p=39864 Computation is no longer the preserve of science and engineering, so I thought I would share a simple computational literary analysis that I did with my daughter.

Shell Lord of the Flies

Hannah’s favorite book is Lord of the Flies by William Golding, and as part of a project she was doing, she wanted to find some quantitative information to support her critique.

Spoiler alert: for those who don’t know it, the book tells the story of a group of schoolboys shipwrecked on an island. Written as a reaction to The Coral Island, an optimistic and uplifting book with a similar initial premise, Lord of the Flies instead relates the boys’ descent into savagery once they are separated from societal influence.

The principle data that Hannah asked for was a timeline of the appearance of the characters. This is a pretty straightforward bit of counting. For a given character name, I can search the text for the positions it appears in, and while I am at it, label the data with Legended so that it looks nicer when plotted.

nameData[name_, label_] :=    Legended[First /@ StringPosition[$lotf, name, IgnoreCase -> True]/    StringLength[$lotf], label]; nameData[name_] := nameData[name, name];

The variable $lotf contains the text of the book (there is some discussion later about how to get that). By dividing the string position by the length of the book, I am rescaling the range to 0–1 to make alignment with later work easier. Now I simply create a Histogram of the data. I used a SmoothHistogram, as it looks nicer. The smoothing parameter of 0.06 is rather subjective, but gave this rather pleasingly smooth overview without squashing all the details.
characters = SmoothHistogram[{    nameData["Ralph"],    nameData["Jack"],    nameData["Beast", "The Beast"]}, 0.06, PlotStyle -> Thickness[0.01],   PlotRange -> {{0, 1}, All}, PlotLabel -> "Character appearances",   Ticks -> None]

Already we can see some of the narrative arc of the book. The protagonist, Ralph, makes an early appearance, closely followed by the antagonist, Jack. The nonexistent Beast appears as a minor character early in the book as the boys explore the island before becoming a major feature in the middle of the book, preceding Jack’s rise as Jack exploits fear of the Beast to take power. Ralph becomes significant again toward the end as the conflict between he and Jack reaches its peak.

But most of Hannah’s critique was about meaning, not plot, so we started talking about the tone of the book. To quantify this, we can use a simple machine learning classifier on the sentences and then do basic statistics on the result.

By breaking the text into sentences and then using the built-in sentiment analyzer, we can hunt out the sentence most likely to be a positive one.

MaximalBy[TextSentences[$lotf],   Classify["Sentiment", #, {"Probability", "Positive"}] &]

The classifier returns only "Positive", "Negative" and "Neutral" classes, so if we map those to numbers we can take a moving average to produce an average sentiment vector with a window of 500 sentences.

sentimentData =    Legended[MeanFilter[      ReplaceAll[       Classify["Sentiment", TextSentences[$lotf]] , {"Positive" -> 1,         "Negative" -> -1, "Neutral" | Indeterminate -> 0}], 500]*20,     "Sentiment"];

Putting that together with the character occurrences allows some interesting insights.

Lord of the Flies high-res

We can see that there is an early negative tone as the boys are shipwrecked, which quickly becomes positive as they explore the island and their newfound freedom. The tone becomes more neutral as concerns rise about the Beast, and turn negative as Jack rises to power. There is a brief period of positivity as Ralph returns to prominence before the book dives into bleak territory as everything goes bad (especially for Piggy).

Digital humanities is a growing field, and I think the relative ease with which the Wolfram Language can be applied to text analysis and other kinds of data science should help computation make useful contributions to many fields that were once considered entirely subjective.

Appendix: Notes on Data Preparation

Because I wanted to avoid needing to OCR my hard copy of the book, I used a digital copy. However, the data was corrupted by some page headers, artifacts of navigation hyperlinks and an index page. So, here is some rather dirty string pattern work to strip out those extraneous words and numbers to produce a clean string containing only narrative:

$lotf = StringReplace[    StringDelete[     StringReplace[      StringDrop[       StringDelete[        Import["http://<redacted>.txt"], {"Page " ~~ Shortest[___] ~~           " of 290\n\nGo Back\n\nFull Screen\n\nClose\n\nQuit",                           "Home Page\n\nTitle Page\n\nContents\n\n!!\n\n\"\"\n\n!\n\n\ \""}], 425],       "\n" -> " "], {"Home Page  " ~~ Shortest[___] ~~        "  Title Page  Contents", "!!  \"\"  !  \"    ", "\f"}],     "  " -> " "];

Appendix 2: Text Labels

This is the code for labeling the plot with key moments in the book:

sentenceLabel[{sentence_String, label_}] :=   Block[{pos =      Once[First[FirstPosition[TextSentences[$lotf], sentence]]]},   Callout[{pos/Length[TextSentences[$lotf]], sentimentData[[1, pos]]},     label, Appearance -> "Balloon"]]

eventLabels = ListPlot[sentenceLabel /@     {      {"As they watched, a flash of fire appeared at the root of one \ wisp, and then the smoke thickened.", "The fire"},            {"Only the beast lay still, a few yards from the sea.",        "Simon dies"},      {"Samneric were savages like the rest; Piggy was dead, and the \ conch smashed to powder.", "Piggy dies"},      {"\[OpenCurlyDoubleQuote]I\[CloseCurlyQuote]m chief then.\ \[CloseCurlyDoubleQuote]", "Ralph leads"},      {"We aren\[CloseCurlyQuote]t enough to keep the fire burning.\ \[CloseCurlyDoubleQuote]", "Ralph usurped"}}];

Appendix 3: Conch Shell Word Cloud Image

It doesn’t provide much insight, but the conch word cloud at the top of the article was generated with this code:

img = Import["http://pngimg.com/uploads/conch/conch_PNG18242.png"]; ImageMultiply[  Rasterize[   WordCloud[DeleteStopwords[$lotf], AlphaChannel[img], MaxItems -> 50,     WordSelectionFunction -> (StringLength[#] >= 4 &)],    ImageSize -> ImageDimensions[img]], ImageAdjust[img, {-0.7, 1.3}]]

Reference—conch shell: Source image from pngimg.com Creative Commons 4.0 BY-NC.

]]>
http://blog.wolfram.com/2017/12/07/tracking-a-descent-to-savagery-with-the-wolfram-language-plotting-sentiment-analysis-in-lord-of-the-flies/feed/ 0
Finding X in Espresso: Adventures in Computational Lexicology http://blog.wolfram.com/2017/11/30/finding-x-in-espresso-adventures-in-computational-lexicology/ http://blog.wolfram.com/2017/11/30/finding-x-in-espresso-adventures-in-computational-lexicology/#comments Thu, 30 Nov 2017 19:08:03 +0000 Vitaliy Kaurov http://blog.internal.wolfram.com/?p=39579 When Does a Word Become a Word?

“A shot of expresso, please.” “You mean ‘espresso,’ don’t you?” A baffled customer, a smug barista—media is abuzz with one version or another of this story. But the real question is not whether “expresso” is a correct spelling, but rather how spellings evolve and enter dictionaries. Lexicographers do not directly decide that; the data does. Long and frequent usage may qualify a word for endorsement. Moreover, I believe the emergent proliferation of computational approaches can help to form an even deeper insight into the language. The tale of expresso is a thriller from a computational perspective.

X in expresso data analysis poster

In the past I had taken the incorrectness of expresso for granted. And how could I not, with the thriving pop-culture of “no X in espresso” posters, t-shirts and even proclamations from music stars such as “Weird Al” Yankovic. Until a statement in a recent note by Merriam-Webster’s online dictionary caught my eye: “… expresso shows enough use in English to be entered in the dictionary and is not disqualified by the lack of an x in its Italian etymon.” Can this assertion be quantified? I hope this computational treatise will convince you that it can. But to set the backdrop right, let’s first look into the history.

Expresso in video segmentNo X in espresso poster

History of Industry and Language

In the 19th century’s steam age, many engineers tackled steam applications accelerating the coffee-brewing process to increase customer turnover, as coffee was a booming business in Europe. The original espresso machine is usually attributed to Angelo Moriondo from Turin, who obtained a patent in 1884 for “new steam machinery for the economic and instantaneous confection of coffee beverage.” But despite further engineering improvements (see the Smithsonian), for decades espresso remained only a local Italian delight. And for words to jump between languages, industries need to jump the borders—this is how industrial evolution triggers language evolution. The first Italian to truly venture the espresso business internationally was Achille Gaggia, a coffee bartender from Milan.

Expresso timeline

In 1938 Gaggia patented a new method using the celebrated lever-driven piston mechanism allowing new record-brewing pressures, quick espresso shots and, as a side effect, even crema foam, a future signature of an excellent espresso. This allowed the Gaggia company (founded in 1948) to commercialize the espresso machines as a consumer product for use in bars. There was about a decade span between the original 1938 patent and its 1949 industrial implementation.

Original espresso maker

Around 1950, espresso machines began crossing Italian borders to the United Kingdom, America and Africa. This is when the first large spike happens in the use of the word espresso in the English language. The spike and following rapid growth are evident from the historic WordFrequencyData of published English corpora plotted across the 20th century:

history[w_] :=   WordFrequencyData[w, "TimeSeries", {1900, 2000}, IgnoreCase -> True]

The function above gets TimeSeries data for the frequencies of words w in a fixed time range from 1900–2000 that, of course, can be extended if needed. The data can be promptly visualized with DateListPlot:

DateListPlot[history[{"espresso", "expresso"}], PlotRange -> All,   PlotTheme -> "Wide"]

The much less frequent expresso also gains its popularity slowly but steadily. Its simultaneous growth is more obvious with the log-scaled vertical frequency axis. To be able to easily switch between log and regular scales and also improve the visual comprehension of multiple plots, I will define a function:

vkWordFreqPlot[list_, plot_] :=    plot[MovingAverage[#, 3] & /@      WordFrequencyData[list, "TimeSeries", {1900, 2000},       IgnoreCase -> True], PlotTheme -> "Detailed", AspectRatio -> 1/3,     Filling -> Bottom, PlotRange -> All, InterpolationOrder -> 2,     PlotLegends -> Placed[Automatic, {Left, Top}]];

The plot below also compares the espresso/expresso pair to a typical pair acknowledged by dictionaries, unfocused/unfocussed, stemming from American/British usage:
vkWordFreqPlot[{"espresso", "expresso", "unfocused",    "unfocussed"}, DateListLogPlot]

The overall temporal behavior of frequencies for these two pairs is quite similar, as it is for many other words of alternative orthography acknowledged by dictionaries. So why is espresso/expresso so controversial? A good historical account is given by Slate Magazine, which, as does Merriam-Webster, supports the official endorsement of expresso. And while both articles give a clear etymological reasoning, the important argument for expresso is its persistent frequent usage (even in such distinguished publications as The New York Times). As it stands as of the date of this blog, the following lexicographic vote has been cast in support of expresso by some selected trusted sources I scanned through. Aye: Merriam-Webster online, Harper Collins online, Random House online. Nay: Cambridge Dictionary online, Oxford Learner’s Dictionaries online, Oxford Dictionaries online (“The spelling expresso is not used in the original Italian and is strictly incorrect, although it is common”; see also the relevant blog), Garner’s Modern American Usage, 3rd edition (“Writers frequently use the erroneous form [expresso]”).

In times of dividing lines, data helps us to refocus on the whole picture and dominant patterns. To stress diversity of alternative spellings, consider the pair amok/amuck:

vkWordFrequencyPlot[{"amok", "amuck"}, DateListPlot]

Of a rather macabre origin, amok came to English around the mid-1600s from the Malay amuk, meaning “murderous frenzy,” referring to a psychiatric disorder of a manic urge to murder. The pair amok/amuck has interesting characteristics. Both spellings can be found in dictionaries. The WordFrequencyData above shows the rich dynamics of oscillating popularity, followed by the competitive rival amuck becoming the underdog. The difference in orthography does not have a typical British/American origin, which should affect how alternative spellings are sampled for statistical analysis further below. And finally, the Levenshtein EditDistance is not equal to 1…

EditDistance["amok", "amuck"]

… in contrast to many typical cases such as:

EditDistance @@@ {{"color", "colour"}, {"realize",     "realise"}, {"aesthetic", "esthetic"}}

This will also affect the sampling of data. My goal is to extract from a dictionary a data sample large enough to describe the diversity of alternatively spelled words that are also structurally close to the espresso/expresso pair. If the basic statistics of this sample assimilate the espresso/expresso pair well, then it quantifies and confirms Merriam-Webster’s assertion that “expresso shows enough use in English to be entered in the dictionary.” But it also goes a step further, because now all pairs from the dictionary sample can be considered as precedents for legitimizing expresso.

Dictionary as Data

Alternative spellings come in pairs and should not be considered separately because there is statistical information in their relation to each other. For instance, the word frequency of expresso should not be compared with the frequency of an arbitrary word in a dictionary. Contrarily, we should consider an alternative spelling pair as a single data point with coordinates {f+, f} denoting higher/lower word frequency of more/less popular spelling correspondingly, and always in that order. I will use the weighted average of a word frequency over all years and all data corpora. It is a better overall metric than a word frequency at a specific date, and avoids the confusion of a frequency changing its state between higher f+ and lower f at different time moments (as we saw for amok/amuck). Weighted average is the default value of WordFrequencyData when no date is specified as an argument.

The starting point is a dictionary that is represented in the Wolfram Language by WordList and contains 84,923 definitions:

Length[words = WordList["KnownWords"]]

There are many types of dictionaries with quite varied sizes. There is no dictionary in the world that contains all words. And, in fact, all dictionaries are outdated as soon as they are published due to continuous language evolution. My assumption is that the exact size or date of a dictionary is unimportant as long as it is “modern and large enough” to produce a quality sample of spelling variants. The curated built-in data of the Wolfram Language, such as WordList, does a great job at this.

We notice right away that language is often prone to quite simple laws and patterns. For instance, it is widely assumed that lengths of words in an English dictionary…

Histogram[StringLength[words], Automatic, "PDF",   PlotTheme -> "Detailed", PlotRange -> All]

… follow quite well one of the simplest statistical distributions, the PoissonDistribution. The Wolfram Language machine learning function FindDistribution picks up on that easily:

FindDistribution[StringLength[words]]

Show[%%, DiscretePlot[PDF[%, k], {k, 0, 33}, Joined -> True]]

My goal is to search for such patterns and laws in the sample of alternative spellings. But first they need to be extracted from the dictionary.

Extracting Spelling Variants

For ease of data processing and analysis, I will make a set of simplifications. First of all, only the following basic parts of speech are considered to bring data closer to the espresso/expresso case:

royalTypes = {"Noun", "Adjective", "Verb", "Adverb"};

This reduces the dictionary to 84,487 words:

royals = DeleteDuplicates[    Flatten[WordList[{"KnownWords", #}] & /@ royalTypes]]; Length[royals]

Deletion of duplicates is necessary, because the same word can be used as several parts of speech. Further, the words containing any characters beyond the lowercase English alphabet are excluded:

outlaws = Complement[Union[Flatten[Characters[words]]], Alphabet[]]

This also removes all proper names, and drops the number of words to 63,712:

laws = Select[royals, ! StringContainsQ[#, outlaws] &]; Length[laws]

Every word is paired with the list of its definitions, and every list of definitions is sorted alphabetically to ensure exact matches in determining alternative spellings:

Define[w_] := w -> Sort[WordDefinition[w]]; defs = Define /@ laws;

Next, words are grouped by their definitions; single-word groups are removed, and definitions themselves are removed too. The resulting dataset contains 8,138 groups:

samedefs =   Replace[GatherBy[defs, Last], {_ -> _} :> Nothing, 1][[All, All, 1]]

Length[samedefs]

Different groups of words with the same definition have a variable number of words n ≥ 2…

Framed[TableForm[Transpose[groups = Sort[Tally[Length /@ samedefs]]],    TableHeadings -> {groupsHead = {"words, n", "groups, m"}, None},    TableSpacing -> {1, 2}]]

… where m is the number of groups. They follow a remarkable power law. Very roughly for order for magnitudes m~200000 n-5.

Show[ListLogLogPlot[groups, PlotTheme -> "Business",    FrameLabel -> groupsHead],  Plot[Evaluate[Fit[Log[groups], {1, x}, x]], {x, Log[2], Log[14]},    PlotStyle -> Red]]

Close synonyms are often grouped together:

Select[samedefs, Length[#] == 10 &]

This happens because WordDefinition is usually quite concise:

WordDefinition /@ {"abjure", "forswear", "recant"}

To separate synonyms from alternative spellings, I could use heuristics based on orthographic rules formulated for classes such as British versus American English. But that would be too complex and unnecessary. It is much easier to consider only word pairs that differ by a small Levenshtein EditDistance. It is highly improbable for synonyms to differ by just a few letters, especially a single one. So while this excludes not only synonyms but also alternative spellings such as amok/amuck, it does help to select words closer to espresso/expresso and hopefully make the data sample more uniform. The computations can be easily generalized to a larger Levenshtein EditDistance, but it would be important and interesting to first check the most basic case:

EditOne[l_] :=    l[[#]] & /@ Union[Sort /@ Position[Outer[EditDistance, l, l], 1]]; samedefspair = Flatten[EditOne /@ samedefs, 1]

This reduces the sample size to 2,882 pairs:

Length[samedefspair]

Mutations of Spellings

Alternative spellings are different orthographic states of the same word that have different probabilities of occurrence in the corpora. They can inter-mutate based on the context or environment they are embedded into. Analysis of such mutations seems intriguing. The mutations can be extracted with help of the SequenceAlignment function. It is based on algorithms from bioinformatics identifying regions of similarity in DNA, RNA or protein sequences, and often wandering into other fields such as linguistics, natural language processing and even business and marketing research. The mutations can be between two characters or a character and a “hole” due to character removal or insertion:

SequenceAlignment @@@ {{"color", "colour"}, {"mesmerise",     "mesmerize"}}

In the extracted mutations’ data, the “hole” is replaced by a dash (-) for visual distinction:

mutation =   Cases[SequenceAlignment @@@ samedefspair, _List, {2}] /. "" -> "-"

The most probable letters to participate in a mutation between alternative spellings can be visualized with Tally. The most popular letters are s and z thanks to the British/American endings -ise/-ize, surpassed only by the popularity of the “hole.” This probably stems from the fact that dropping letters often makes orthography and phonetics easier.

vertex = Association[Rule @@@ SortBy[Tally[Flatten[mutation]], Last]]; optChart = {ColorFunction -> "Rainbow", BaseStyle -> 15,     PlotTheme -> "Web"}; inChar = PieChart[vertex, optChart, ChartLabels -> Callout[Automatic],     SectorOrigin -> -Pi/9]; BarChart[Reverse[vertex], optChart, ChartLabels -> Automatic,  Epilog -> Inset[inChar, Scaled[{.6, .5}], Automatic, Scaled[1.1]]]

Querying Word Frequencies

The next step is to get the WordFrequencyData for all
2 x 2882 = 5764 words of alternative spelling stored in the variable samedefspair. WordFrequencyData is a very large dataset, and it is stored on Wolfram servers. To query frequencies for a few thousands words efficiently, I wrote some special code that can be found in the notebook attached at the end of this blog. The resulting data is an Association containing alternative spellings with ordered pairs of words as keys and ordered pairs of frequencies as values. The higher-frequency entry is always first:

data

The size of the data is slightly less than the original queried set because for some words, frequencies are unknown:

{Length[data], Length[samedefspair] - Length[data]}

Basic Analysis

Having obtained the data, I am now ready to check how well the frequencies of espresso/expresso fall within this data:

esex = Values[   WordFrequencyData[{"espresso", "expresso"}, IgnoreCase -> True]]

As a start, I will examine if there are any correlations between lower and higher frequencies. Pearson’s Correlation coefficient, a measure of the strength of the linear relationship between two variables, gives a high value for lower versus higher frequencies:

Correlation @@ Transpose[Values[data]]

But plotting frequency values at their natural scale hints that a log scale could be more appropriate:

ListPlot[Values[data], AspectRatio -> Automatic,   PlotTheme -> "Business", PlotRange -> All]

And indeed for log-values of frequencies, the Correlation strength is significantly higher:

Correlation @@ Transpose[Log[Values[data]]]

Fitting the log-log of data reveals a nice linear fit…

lmf = LinearModelFit[Log[Values[data]], x, x]; lmf["BestFit"]

… with sensible statistics of parameters:

lmf["ParameterTable"]

In the frequency space, this shows a simple and quite remarkable power law that sheds light on the nature of correlations between the frequencies of less and more popular spellings of the same word:

Reduce[Log[SubMinus[f]] == lmf["BestFit"] /.    x -> Log[SubPlus[f]], SubMinus[f], Reals]

Log-log space gives a clear visualization of the data. Obviously due to {greater, smaller} sorting of coordinates {f+, f}, all data points cannot exceed the Log[f]==Log[f+] limiting orange line. The purple line is the linear fit of the power law. The red circle is the median of the data, and the red dot is the value of the espresso/expresso frequency pair:
ListLogLogPlot[data, PlotRange -> All, AspectRatio -> Automatic,   PlotTheme -> "Detailed",  		ImageSize -> 800, Epilog -> {{Purple, Thickness[.004], Opacity[.4],     	Line[Transpose[{{-30, 0}, Normal[lmf] /. x -> {-30, 0}}]]},    		{Orange, Thickness[.004], Opacity[.4],      Line[{-30 {1, 1}, -10 {1, 1}}]},    		{Red, Opacity[.5], PointSize[.02], Point[Log[esex]]},    		{Red, Opacity[.5], Thickness[.01],      Circle[Median[Log[Values[data]]], .2]}}]

A simple, useful transformation of the coordinate system will help our understanding of the data. Away from log-frequency vs. log-frequency space we go. The distance from a data point to the orange line Log[f]==Log[f+] is the measure of how many times larger the higher frequency is than the lower. It is given by a linear transformation—rotation of the coordinate system by 45 degrees. Because this distance is given by difference of logs, it relates to the ratio of frequencies:

TraditionalForm[PowerExpand[Log[(SubPlus[f]/SubMinus[f])^2^(-1/2)]]]

This random variable is well fit by the very famous and versatile WeibullDistribution, which is used universally for weather forecasting to describe wind speed distributions; survival analysis; reliability, industrial and electrical engineering; extreme value theory; forecasting technological change; and much more—including, now, word frequencies:

dist = FindDistribution[   trans = (#1 - #2)/Sqrt[2] & @@@ Log[Values[data]]]

One of the most fascinating facts is “The Unreasonable Effectiveness of Mathematics in the Natural Sciences,” which is the title of a 1960 paper by the physicist Eugene Wigner. One of its notions is that mathematical concepts often apply uncannily and universally far beyond the context in which they were originally conceived. We might have glimpsed at that in our data.

Using statistical tools, we can figure out that in the original space the frequency ratio obeys a distribution with a nice analytic formula:

Assuming[SubPlus[f]/SubMinus[f] > 1,   PDF[TransformedDistribution[E^(Sqrt[2] u),     u \[Distributed] WeibullDistribution[a, b]], SubPlus[f]/SubMinus[   f]]]

It remains to note that the other corresponding transformed coordinate relates to the frequency product…

TraditionalForm[PowerExpand[Log[(SubPlus[f] SubMinus[f])^2^(-1/2)]]]

… and is the position of a data point along the orange line Log[f]==Log[f+]. It reflects how popular, on average, a specific word pair is among other pairs. One can see that the espresso/expresso value lands quite above the median, meaning the frequency of its usage is higher than half of the data points.

Nearest can find the closest pairs to espresso/expresso measured by EuclideanDistance in the frequency space. Taking a look at the 50 nearest pairs shows just how typical the frequencies espresso/expresso are, shown below by a red dot. Many nearest neighbors, such as energize/energise and zombie/zombi, belong to the basic everyday vocabulary of most frequent usage:

neighb = Nearest[data, esex, 50]; ListPlot[Association @@ Thread[neighb -> data /@ neighb],  	PlotRange -> All, AspectRatio -> Automatic, PlotTheme -> "Detailed",  	Epilog -> {{Red, Opacity[.5], PointSize[.03], Point[esex]}}]

The temporal behavior of frequencies for a few nearest neighbors shows significant diversity and often is generally reminiscent of such behavior for the espresso/expresso pair that was plotted at the beginning of this article:

Multicolumn[vkWordFreqPlot[#, DateListPlot] & /@ neighb[[;; 10]], 2]

Networks of Mutation

Frequencies allow us to define a direction of mutation, which can be visualized by a DirectedEdge always pointing from lower to higher frequency. A Tally of the edges defines weights (or not-normalized probabilities) of particular mutations.

muteWeigh =    Tally[Cases[SequenceAlignment @@@ Keys[data], _List, {2}] /.      "" -> "-"]; edge = Association[Rule @@@ Transpose[{       DirectedEdge @@ Reverse[#] & /@ muteWeigh[[All, 1]],        N[Rescale[muteWeigh[[All, 2]]]]}]];

For clarity of visualization, all edges with weights less than 10% of the maximum value are dropped. The most popular mutation is sz->1, with maximum weight 1. It is interesting to note that reverse mutations might occur too; for instance, zs->0.0347938, but much less often:

cutEdge = ReverseSort[ Select[edge, # > .01 &]]

PieChart[cutEdge, optChart, ChartLabels -> Callout[Automatic]]

Thus a letter can participate in several types of mutations, and in this sense mutations form a network. The size of the vertex is correlated with the probability of a letter to participate in any mutation (see the variable vertex above):

vs = Thread[Keys[vertex] -> 2 N[.5 + Rescale[Values[vertex]]]];

The larger the edge weight, the brighter the edge:

es = Thread[    Keys[cutEdge] -> (Directive[Thickness[.003], Opacity[#]] & /@        N[Values[cutEdge]^.3])];

The letters r and g participate mostly in the deletion mutation. Letters with no edges participate in very rare mutations.

graphHighWeight =   Graph[Keys[vertex], Keys[cutEdge], PerformanceGoal -> "Quality",   VertexLabels -> Placed[Automatic, Center], VertexLabelStyle -> 15,    VertexSize -> vs, EdgeStyle -> es]

Among a few interesting substructures, one of the obvious is the high clustering of vowels. A Subgraph of vowels can be easily extracted…

vowels = {"a", "e", "i", "o", "u"}; Subgraph[graphHighWeight, vowels, GraphStyle -> "SmallNetwork"]

… and checked for completeness, which yields False due to many missing edges from and to u:

CompleteGraphQ[%]

Nevertheless, as you might remember, the low-weight edges were dropped for a better visual of high-weight edges. Are there any interesting observations related to low-weight edges? As a matter of fact, yes, there are. Let’s quickly rebuild a full subgraph for only vowels. Vertex sizes are still based on the tally of letters in mutations:

vowelsVertex =   Association @@    Cases[Normal[vertex], Alternatives @@ (# -> _ & /@ vowels)]

vsVow = Thread[    Keys[vowelsVertex] -> .2 N[.5 + Rescale[Values[vowelsVertex]]]];

All mutations of vowels in the dictionary can be extracted with the help of MemberQ:

vowelsMute =    Select[muteWeigh, And @@ (MemberQ[vowels, #] & /@ First[#]) &]; vowelsEdge = Association[Rule @@@    Transpose[     MapAt[DirectedEdge @@ Reverse[#] & /@ # &, Transpose[vowelsMute],       1]]]

In order to visualize exactly the number of vowel mutations in the dictionary, the edge style is kept uniform and edge labels are used for nomenclature:

vowelGraph = Graph[Keys[vowelsVertex], Keys[vowelsEdge],   EdgeWeight -> vowelsMute[[All, 2]], PerformanceGoal -> "Quality",    VertexLabels -> Placed[Automatic, Center], VertexLabelStyle -> 20,    VertexSize -> vsVow, EdgeLabels -> "EdgeWeight",    EdgeLabelStyle -> Directive[15, Bold]]

And now when we consider all (even small-weight) mutations, the graph is complete:

CompleteGraphQ[vowelGraph]

But this completeness is quite “weak” in the sense that there are many edges with a really small weight, in particular two edges with weight 1:

Select[vowelsMute, Last[#] == 1 &]

This means that there is only one alternative word pair for eu mutations, and likewise for io mutations. With the help of a lookup function…

lookupMute[l_] := With[{keys = Keys[data]}, keys[[Position[       SequenceAlignment @@@ keys /. "" -> "-",        Alternatives @@ l, {2}][[All, 1]]]]]

… these pairs can be found as:

lookupMute[{{"o", "i"}, {"u", "e"}}]

Thus, thanks to these unique and quite exotic words, our dictionaries have eu and io mutations. Let’s check WordDefinition for these terms:

TableForm[WordDefinition /@ #,     TableHeadings -> {#, None}] &@{"corticofugal", "yarmulke"}

The word yarmulke is a quite curious case. First of all, it has three alternative spellings:

Nearest[WordData[], "yarmulke", {All, 1}]

Additionally, the Merriam-Webster Dictionary suggests a rich etymology: “Yiddish yarmlke, from Polish jarmułka & Ukrainian yarmulka skullcap, of Turkic origin; akin to Turkish yağmurluk rainwear.” The Turkic class of languages is quite wide:

EntityList[EntityClass["Language", "Turkic"]]

Together with the other mentioned languages, Turkic languages mark a large geographic area as the potential origin and evolution of the word yarmulke:

locs = DeleteDuplicates[Flatten[EntityValue[     {EntityClass["Language", "Turkic"],       EntityClass["Language", "Yiddish"], Entity["Language", "Polish"],       Entity["Language", "Ukrainian"]},      EntityProperty["Language", "PrimaryOrigin"]]]]

GeoGraphics[GeoMarker[locs, "Scale" -> Scaled[.03]],   GeoRange -> "World", GeoBackground -> "Coastlines",   GeoProjection -> "WinkelTripel"]

This evolution has Yiddish as an important stage before entering English, while Yiddish itself has a complex cultural history. English usage of yarmulke spikes around 1940–1945, hence World War II and the consequent Cold War era are especially important in language migration, correlated probably to the world migration and changes in Jewish communities during these times.

vkWordFreqPlot[{"yarmulke", "yarmelke", "yarmulka"}, DateListLogPlot]

These complex processes brought many more Yiddish words to English (my personal favorites are golem and glitch), but only a single one resulted in the introduction of the mutation eu in the whole English dictionary (at least within our dataset). So while there are really no sx mutations currently in English (as in espresso/expresso), this is not a negative indicator because there are cases of mutations that are unique to a single or just a few words. And actually, there are many more such mutations with a small weight than with a large weight:

ListLogLogPlot[Sort[Tally[muteWeigh[[All, 2]]]],   PlotTheme -> "Detailed",  PlotRange -> All,   FrameLabel -> {"mutation weight", "number of weights"},   Epilog -> Text[Style["s" \[DirectedEdge] "z", 15], Log@{600, 1.2}],   Filling -> Bottom]

So while the sz mutation happens in 777 words, it is the only mutation with that weight:

MaximalBy[muteWeigh, Last]

On the other hand, there are 61 unique mutations that happen only once in a single word, as can be seen from the plot above. So in this sense, the most weighted sz mutation is an outlier, and if expresso enters a dictionary, then the espresso/expresso pair will join the majority of unique mutations with weight 1. These are the mutation networks for the first four small weights:

vkWeight[n_] := Select[muteWeigh, Last[#] == n &][[All, 1]] vkMutationNetwork[n_] :=   Graph[DirectedEdge @@ Reverse[#] & /@ vkWeight[n],   VertexLabels -> Placed[Automatic, Center], VertexLabelStyle -> 15,   VertexSize -> Scaled[.07], AspectRatio -> 1,    PerformanceGoal -> "Quality",   PlotLabel -> "Mutation Weight = " <> ToString[n]] Grid[Partition[vkMutationNetwork /@ Range[4], 2], Spacings -> {1, 1},   Frame -> All]

As the edge weight gets larger, networks become simpler—degenerating completely for very large weights. Let’s examine a particular set of mutations with a small weight—for instance, weight 2:

DirectedEdge @@ Reverse[#] & /@   Select[muteWeigh, Last[#] == 1 &][[All, 1]]

This means there are only two unique alternative spellings (four words) for each mutation out of the whole dictionary:

Multicolumn[  Row /@ Replace[    SequenceAlignment @@@ (weight2 = lookupMute[vkWeight[2]]) /.      "" -> "-", {x_, y_} :> Superscript[x, Style[y, 13, Red]], {2}], 4]

Red marks a less popular letter, printed as a superscript of the more popular one. While the majority of these pairs are truly alternative spellings with a sometimes curiously dynamic history of usage…

vkWordFreqPlot[{"fjord", "fiord"}, DateListPlot]

… some occasional pairs, like distrust/mistrust, indicate blurred lines between alternative spellings and very close synonyms with close orthographic forms—here the prefixes mis- and dis-. Such rare situations can be considered as a source of noise in our data if someone does not want to accept them as true alternative spellings. My personal opinion is that the lines are blurred indeed, as the prefixes mis- and dis- themselves can be considered alternative spellings of the same semantic notion.

These small-weight mutations (white dots in the graph below) are distributed among the rest of the data (black dots) really well, which reflects on their typicality. This can be visualized by constructing a density distribution with SmoothDensityHistogram, which uses SmoothKernelDistribution behind the scenes:

SmoothDensityHistogram[Log[Values[data]],  Mesh -> 50, ColorFunction -> "DarkRainbow", MeshStyle -> Opacity[.2],  PlotPoints -> 200, PlotRange -> {{-23, -11}, {-24, -12}}, Epilog -> {    {Black, Opacity[.4], PointSize[.002], Point[Log[Values[data]]]},    {White, Opacity[.7], PointSize[.01],      Point[Log[weight2 /. Normal[data]]]},    {Red, Opacity[1], PointSize[.02], Point[Log[esex]]},    {Red, Opacity[1], Thickness[.01],      Circle[Median[Log[Values[data]]], .2]}}]

Some of these very exclusive, rare alternative spellings are even more or less frequently used than espresso/expresso, as shown above for the example of weight 2, and can be also shown for other weights. Color and contour lines provide a visual guide for where the values of density of data points lie.

Conclusion

The following factors affirm why expresso should be allowed as a valid alternative spelling.

  • Espresso/expresso falls close to the median usage frequencies of 2,693 official alternative spellings with Levenshtein EditDistance equal to 1
  • The frequency of espresso/expresso usage as whole pair is above the median, so it is more likely to be found in published corpora than half of the examined dataset
  • Many nearest neighbors of espresso/expresso in the frequency space belong to a basic vocabulary of the most frequent everyday usage
  • The history of espresso/expresso usage in English corpora shows simultaneous growth for both spellings, and by temporal pattern is reminiscent of many other official alternative spellings
  • The uniqueness of the sx mutation in the espresso/expresso pair is typical, as numerous other rare and unique mutations are officially endorsed by dictionaries

So all in all, it is ultimately up to you how to interpret this analysis or spell the name of the delightful Italian drink. But if you are a wisenheimer type, you might consider being a tinge more open-minded. The origin of words, as with the origin of species, has its dark corners, and due to inevitable and unpredictable language evolution, one day your remote descendants might frown on the choice of s in espresso.


Download this post as a Computable Document Format (CDF) file. New to CDF? Get your copy for free with this one-time download. If you would like to change parameters to make your own data exploration, download the full notebook.

]]>
http://blog.wolfram.com/2017/11/30/finding-x-in-espresso-adventures-in-computational-lexicology/feed/ 5
How to Win at Risk: Exact Probabilities http://blog.wolfram.com/2017/11/20/how-to-win-at-risk-exact-probabilities/ http://blog.wolfram.com/2017/11/20/how-to-win-at-risk-exact-probabilities/#comments Mon, 20 Nov 2017 17:54:43 +0000 Jon McLoone http://blog.internal.wolfram.com/?p=39293 The classic board game Risk involves conquering the world by winning battles that are played out using dice. There are lots of places on the web where you can find out the odds of winning a battle given the number of armies that each player has. However, all the ones that I have seen do this by Monte Carlo simulation, and so are innately approximate. The Wolfram Language makes it so easy to work out the exact values that I couldn’t resist calculating them once and for all.

Risk battle odds flow chart

Here are the basic battle rules: the attacker can choose up to three dice (but must have at least one more army than dice), and the defender can choose up to two (but must have at least two armies to use two). To have the best chances of winning, you always use the most dice possible, so I will ignore the other cases. Both players throw simultaneously and then the highest die from each side is paired, and (if both threw at least two dice) the next highest are paired. The highest die kills an army and, in the event of a draw, the attacker is the loser. This process is repeated until one side runs out of armies.

So my goal is to create a function pBattle[a,d] that returns the probability that the battle ends ultimately as a win for the attacker, given that the attacker started with a armies and the defender started with d armies.

I start by coding the basic game rules. The main case is when both sides have enough armies to fight with at least two dice. There are three possible outcomes for a single round of the battle. The attacker wins twice or loses twice, or both sides lose one army. The probability of winning the battle is therefore the sum of the probabilities of winning after the killed armies are removed multiplied by the probability of that outcome.

pBattle[a_, d_] /; (a >= 3 && d >= 2) := Once[    pWin2[a, d] pBattle[a, d - 2] +      pWin1Lose1[a, d] pBattle[a - 1, d - 1] +      pLose2[a, d] pBattle[a - 2, d]    ];

We also have to cover the case that either side has run low on armies and there is only one game piece at stake.

pBattle[a_, d_] /; (a > 1 && d >= 1) := Once[    pWin1[a, d] pBattle[a, d - 1] + pLose1[a, d] pBattle[a - 1, d]    ];

This sets up a recursive definition that defines all our battle probabilities in terms of the probabilities of subsequent stages of the battle. Once prevents us working those values out repeatedly. We just need to terminate this recursion with the end-of-battle rules. If the attacker has only one army, he has lost (since he must have more armies than dice), so our win probability is zero. If our opponent has run out of armies, then the attacker has won.

pBattle[1, _] = 0; pBattle[_, 0] = 1;

Now we have to work out the probabilities of our five individual attack outcomes: pWin2, pWin1Lose1, pLose2, pWin1 and pLose1.

When using two or three dice, we can describe the distribution as an OrderDistribution of a DiscreteUniformDistribution because we always want to pair the highest throws together.

diceDistribution[n : 3 | 2] :=    OrderDistribution[{DiscreteUniformDistribution[{1, 6}], n}, {n - 1,      n}];

For example, here is one outcome of that distribution; the second number will always be the largest, due to the OrderDistribution part.

RandomVariate[diceDistribution[3]]

The one-die case is just a uniform distribution; our player has to use the value whether it is good or not. However, for programming convenience, I am going to describe a distribution of two numbers, but we will never look at the first.

diceDistribution[1] := DiscreteUniformDistribution[{{1, 6}, {1, 6}}];

So now the probability of winning twice is that both attacker dice are greater than both defenders. The defender must be using two dice, but the attacker could be using two or three.

pWin2[a_, d_] /; a >= 3 && d >= 2 := Once[    Probability[     a1 > d1 &&       a2 > d2, {{a1, a2} \[Distributed]        diceDistribution[Min[a - 1, 3]], {d1, d2} \[Distributed]        diceDistribution[2]}]    ];

The lose-twice probability has a similar definition.

pLose2[a_, d_] := Once[    Probability[     a1 <= d1 &&       a2 <= d2, {{a1, a2} \[Distributed]        diceDistribution[Min[a - 1, 3]], {d1, d2} \[Distributed]        diceDistribution[2]}]    ];

And the draw probability is what’s left.

pWin1Lose1[a_, d_] := Once[1 - pWin2[a, d] - pLose2[a, d]]

The one-army battle could be because the attacker is low on armies or because the defender is. Either way, we look only at the last value of our distributions.

pWin1[a_, d_] /; a === 2 || d === 1 := Once[    Probability[     a2 > d2, {{a1, a2} \[Distributed]        diceDistribution[Min[a - 1, 3]], {d1, d2} \[Distributed]        diceDistribution[Min[d, 2]]}]    ];

And pLose1 is just the remaining case.

pLose1[a_, d_] := 1 - pWin1[a, d];

And we are done. All that is left is to use the function. Here is the exact (assuming fair dice, and no cheating!) probability of winning if the attacker starts with 18 armies and the defender has only six.

pBattle[18, 6]

We can approximate this to 100 decimal places.

N[%, 100]

We can quickly enumerate the probabilities for lots of different starting positions.

table = Text@   Grid[Prepend[     Table[Prepend[Table[pBattle[a, d], {d, 1, 4}],        StringForm["Attack with " <> ToString[a]]], {a, 2, 16}],     Prepend[      Table[StringForm["Defend with " <> ToString[n]], {n, 1, 4}],       ""]], Frame -> All, FrameStyle -> LightGray]

Risk odds table 1

Here are the corresponding numeric values to only 20 decimal places.

N[table, 20]

Risk odds table 2

You can download tables of more permutations here, with exact numbers, and here, approximated to 20 digits.

Of course, this level of accuracy is rather pointless. If you look at the 23 vs. 1 battle, the probability of losing is about half the probability that you will actually die during the first throw of the dice, and certainly far less than the chances of your opponent throwing the board in the air and refusing to play ever again.

Appendix: Code for Generating the Outcomes Graph


vf[{x_, y_}, name_, {w_, h_}] := {Black, Circle[{x, y}, w], Black,     Text[If[StringQ[name], Style[name, 12],       Style[Row[name, "\[ThinSpace]vs\[ThinSpace]"], 9]], {x, y}]}; edge[e_, th_] :=    Property[e, EdgeStyle -> {Arrowheads[th/15], Thickness[th/40]}]; Graph[Flatten[Table[If[a >= 3 && d >= 2,      {       edge[{a, d} -> {a, d - 2}, pWin2[a, d]],       edge[{a, d} -> {a - 1, d - 1}, pWin1Lose1[a, d]],       edge[{a, d} -> {a - 2, d}, pLose2[a, d]]              },      {       edge[{a, d} -> {a, d - 1}, pWin1[a, d]],       edge[{a, d} -> {a - 1, d}, pLose1[a, d]]              }], {a, 2, 6}, {d, 1, 4}]] /. {{a_, 0} -> "Win", {1, d_} ->      "Lose"}, ImageSize -> Full, VertexShapeFunction -> vf,   VertexSize -> 1]


Download this post as a Computable Document Format (CDF) file. New to CDF? Get your copy for free with this one-time download.

]]>
http://blog.wolfram.com/2017/11/20/how-to-win-at-risk-exact-probabilities/feed/ 1
What Is a Computational Essay? http://blog.wolfram.com/2017/11/14/what-is-a-computational-essay/ http://blog.wolfram.com/2017/11/14/what-is-a-computational-essay/#comments Tue, 14 Nov 2017 18:54:55 +0000 Stephen Wolfram http://blog.internal.wolfram.com/?p=39273 A Powerful Way to Express Ideas

People are used to producing prose—and sometimes pictures—to express themselves. But in the modern age of computation, something new has become possible that I’d like to call the computational essay.

I’ve been working on building the technology to support computational essays for several decades, but it’s only very recently that I’ve realized just how central computational essays can be to both the way people learn, and the way they communicate facts and ideas. Professionals of the future will routinely deliver results and reports as computational essays. Educators will routinely explain concepts using computational essays. Students will routinely produce computational essays as homework for their classes.

Here’s a very simple example of a computational essay:

Simple computational essay example

There are basically three kinds of things here. First, ordinary text (here in English). Second, computer input. And third, computer output. And the crucial point is that these all work together to express what’s being communicated.

The ordinary text gives context and motivation. The computer input gives a precise specification of what’s being talked about. And then the computer output delivers facts and results, often in graphical form. It’s a powerful form of exposition that combines computational thinking on the part of the human author with computational knowledge and computational processing from the computer.

But what really makes this work is the Wolfram Language—and the succinct representation of high-level ideas that it provides, defining a unique bridge between human computational thinking and actual computation and knowledge delivered by a computer.

In a typical computational essay, each piece of Wolfram Language input will usually be quite short (often not more than a line or two). But the point is that such input can communicate a high-level computational thought, in a form that can readily be understood both by the computer and by a human reading the essay.

It’s essential to all this that the Wolfram Language has so much built-in knowledge—both about the world and about how to compute things in it. Because that’s what allows it to immediately talk not just about abstract computations, but also about real things that exist and happen in the world—and ultimately to provide a true computational communication language that bridges the capabilities of humans and computers.

An Example

Let’s use a computational essay to explain computational essays.

Let’s say we want to talk about the structure of a human language, like English. English is basically made up of words. Let’s get a list of the common ones.

Generate a list of common words in English:

WordList[]

WordList[]

How long is a typical word? Well, we can take the list of common words, and make a histogram that shows their distribution of lengths.

Make a histogram of word lengths:

Histogram[StringLength[WordList[]]]

Histogram[StringLength[WordList[]]]

Do the same for French:

Histogram[StringLength[WordList[Language -> "French"]]]

Histogram[StringLength[WordList[Language -> "French"]]]

Notice that the word lengths tend to be longer in French. We could investigate whether this is why documents tend to be longer in French than in English, or how this relates to quantities like entropy for text. (Of course, because this is a computational essay, the reader can rerun the computations in it themselves, say by trying Russian instead of French.)

But as something different, let’s compare languages by comparing their translations for, say, the word “computer”.

Find the translations for “computer” in the 10 most common languages:

Take[WordTranslation["computer", All], 10]

Take[WordTranslation["computer", All], 10]

Find the first translation in each case:

First /@ Take[WordTranslation["computer", All], 10]

First /@ Take[WordTranslation["computer", All], 10]

Arrange common languages in “feature space” based on their translations for “computer”:

FeatureSpacePlot[First /@ Take[WordTranslation["computer", All], 40]]

FeatureSpacePlot[First /@ Take[WordTranslation["computer", All], 40]]

From this plot, we can start to investigate all sorts of structural and historical relationships between languages. But from the point of view of a computational essay, what’s important here is that we’re sharing the exposition between ordinary text, computer input, and output.

The text is saying what the basic point is. Then the input is giving a precise definition of what we want. And the output is showing what’s true about it. But take a look at the input. Even just by looking at the names of the Wolfram Language functions in it, one can get a pretty good idea what it’s talking about. And while the function names are based on English, one can use “code captions” to understand it in another language, say Japanese:

FeatureSpacePlot[First/@Take[WordTranslation["computer",All],40]]

FeatureSpacePlot[First /@ Take[WordTranslation["computer", All], 40]]

But let’s say one doesn’t know about FeatureSpacePlot. What is it? If it was just a word or phrase in English, we might be able to look in a dictionary, but there wouldn’t be a precise answer. But a function in the Wolfram Language is always precisely defined. And to know what it does we can start by just looking at its documentation. But much more than that, we can just run it ourselves to explicitly see what it does.

FeatureSpacePlot page

And that’s a crucial part of what’s great about computational essays. If you read an ordinary essay, and you don’t understand something, then in the end you really just have to ask the author to find out what they meant. In a computational essay, though, there’s Wolfram Language input that precisely and unambiguously specifies everything—and if you want to know what it means, you can just run it and explore any detail of it on your computer, automatically and without recourse to anything like a discussion with the author.

Practicalities

How does one actually create a computational essay? With the technology stack we have, it’s very easy—mainly thanks to the concept of notebooks that we introduced with the first version of Mathematica all the way back in 1988. A notebook is a structured document that mixes cells of text together with cells of Wolfram Language input and output, including graphics, images, sounds, and interactive content:

A typical notebook

In modern times one great (and very hard to achieve!) thing is that full Wolfram Notebooks run seamlessly across desktop, cloud and mobile. You can author a notebook in the native Wolfram Desktop application (Mac, Windows, Linux)—or on the web through any web browser, or on mobile through the Wolfram Cloud app. Then you can share or publish it through the Wolfram Cloud, and get access to it on the web or on mobile, or download it to desktop or, now, iOS devices.

Notebook environments

Sometimes you want the reader of a notebook just to look at it, perhaps opening and closing groups of cells. Sometimes you also want them to be able to operate the interactive elements. And sometimes you want them to be able to edit and run the code, or maybe modify the whole notebook. And the crucial point is that all these things are easy to do with the cloud-desktop-mobile system we’ve built.

A New Form of Student Work

Computational essays are great for students to read, but they’re also great for students to write. Most of the current modalities for student work are remarkably old. Write an essay. Give a math derivation. These have been around for millennia. Not that there’s anything wrong with them. But now there’s something new: write a computational essay. And it’s wonderfully educational.

A computational essay is in effect an intellectual story told through a collaboration between a human author and a computer. The computer acts like a kind of intellectual exoskeleton, letting you immediately marshall vast computational power and knowledge. But it’s also an enforcer of understanding. Because to guide the computer through the story you’re trying to tell, you have to understand it yourself.

When students write ordinary essays, they’re typically writing about content that in some sense “already exists” (“discuss this passage”; “explain this piece of history”; …). But in doing computation (at least with the Wolfram Language) it’s so easy to discover new things that computational essays will end up with an essentially inexhaustible supply of new content, that’s never been seen before. Students will be exploring and discovering as well as understanding and explaining.

When you write a computational essay, the code in your computational essay has to produce results that fit with the story you’re telling. It’s not like you’re doing a mathematical derivation, and then some teacher tells you you’ve got the wrong answer. You can immediately see what your code does, and whether it fits with the story you’re telling. If it doesn’t, well then maybe your code is wrong—or maybe your story is wrong.

What should the actual procedure be for students producing computational essays? At this year’s Wolfram Summer School we did the experiment of asking all our students to write a computational essay about anything they knew about. We ended up with 72 interesting essays—exploring a very wide range of topics.

In a more typical educational setting, the “prompt” for a computational essay could be something like “What is the typical length of a word in English” or “Explore word lengths in English”.

There’s also another workflow I’ve tried. As the “classroom” component of a class, do livecoding (or a live experiment). Create or discover something, with each student following along by doing their own computations. At the end of the class, each student will have a notebook they made. Then have their “homework” be to turn that notebook into a computational essay that explains what was done.

And in my experience, this ends up being a very good exercise—that really tests and cements the understanding students have. But there’s also something else: when students have created a computational essay, they have something they can keep—and directly use—forever.

And this is one of the great general features of computational essays. When students write them, they’re in effect creating a custom library of computational tools for themselves—that they’ll be in a position to immediately use at any time in the future. It’s far too common for students to write notes in a class, then never refer to them again. Yes, they might run across some situation where the notes would be helpful. But it’s often hard to motivate going back and reading the notes—not least because that’s only the beginning; there’s still the matter of implementing whatever’s in the notes.

But the point is that with a computational essay, once you’ve found what you want, the code to implement it is right there—immediately ready to be applied to whatever has come up.

Any Subject You Want

What can computational essays be about? Almost anything! I’ve often said that for any field of study X (from archaeology to zoology), there either is now, or soon will be, a “computational X”. And any “computational X” can immediately be explored and explained using computational essays.

But even when there isn’t a clear “computational X” yet,  computational essays can still be a powerful way to organize and present material. In some sense, the very fact that a sequence of computations are typically needed to “tell the story” in an essay helps define a clear backbone for the whole essay. In effect, the structured nature of the computational presentation helps suggest structure for the narrative—making it easier for students (and others) to write essays that are easy to read and understand.

But what about actual subject matter? Well, imagine you’re studying history—say the history of the English Civil War. Well, conveniently, the Wolfram Language has a lot of knowledge about history (as about so many other things) built in. So you can present the English Civil War through a kind of dialog with it. For example, you can ask it for the geography of battles:

GeoListPlot[\!\(\*
NamespaceBox["LinguisticAssistant",
DynamicModuleBox[{Typeset`query$$ = "English Civil War",
      Typeset`boxes$$ = TemplateBox[{"\"English Civil War\"",
RowBox[{"Entity", "[",
RowBox[{"\"MilitaryConflict\"", ",", "\"EnglishCivilWar\""}], "]"}],
        "\"Entity[\\\"MilitaryConflict\\\", \
\\\"EnglishCivilWar\\\"]\"", "\"military conflict\""}, "Entity"],
      Typeset`allassumptions$$ = {{
       "type" -> "Clash", "word" -> "English Civil War",
        "template" -> "Assuming \"${word}\" is ${desc1}. Use as \
${desc2} instead", "count" -> "3",
        "Values" -> {{
          "name" -> "MilitaryConflict",
           "desc" -> "a military conflict",
           "input" -> "*C.English+Civil+War-_*MilitaryConflict-"}, {
          "name" -> "Word", "desc" -> "a word",
           "input" -> "*C.English+Civil+War-_*Word-"}, {
          "name" -> "HistoricalEvent", "desc" -> "a historical event",
            "input" -> "*C.English+Civil+War-_*HistoricalEvent-"}}}, {
       "type" -> "SubCategory", "word" -> "English Civil War",
        "template" -> "Assuming ${desc1}. Use ${desc2} instead",
        "count" -> "4",
        "Values" -> {{
          "name" -> "EnglishCivilWar",
           "desc" -> "English Civil War (1642 - 1651)",
           "input" -> "*DPClash.MilitaryConflictE.English+Civil+War-_*\
EnglishCivilWar-"}, {
          "name" -> "FirstEnglishCivilWar",
           "desc" -> "English Civil War (1642 - 1646)",
           "input" -> "*DPClash.MilitaryConflictE.English+Civil+War-_*\
FirstEnglishCivilWar-"}, {
          "name" -> "SecondEnglishCivilWar",
           "desc" -> "Second English Civil War",
           "input" -> "*DPClash.MilitaryConflictE.English+Civil+War-_*\
SecondEnglishCivilWar-"}, {
          "name" -> "ThirdEnglishCivilWar",
           "desc" -> "Third English Civil War",
           "input" -> "*DPClash.MilitaryConflictE.English+Civil+War-_*\
ThirdEnglishCivilWar-"}}}}, Typeset`assumptions$$ = {},
      Typeset`open$$ = {1, 2}, Typeset`querystate$$ = {
      "Online" -> True, "Allowed" -> True,
       "mparse.jsp" -> 1.305362`6.5672759594240935,
       "Messages" -> {}}},
DynamicBox[ToBoxes[
AlphaIntegration`LinguisticAssistantBoxes["", 4, Automatic,
Dynamic[Typeset`query$$],
Dynamic[Typeset`boxes$$],
Dynamic[Typeset`allassumptions$$],
Dynamic[Typeset`assumptions$$],
Dynamic[Typeset`open$$],
Dynamic[Typeset`querystate$$]], StandardForm],
ImageSizeCache->{265., {7., 17.}},
TrackedSymbols:>{
        Typeset`query$$, Typeset`boxes$$, Typeset`allassumptions$$,
         Typeset`assumptions$$, Typeset`open$$, Typeset`querystate$$}],
DynamicModuleValues:>{},
UndoTrackedVariables:>{Typeset`open$$}],
BaseStyle->{"Deploy"},
DeleteWithContents->True,
Editable->False,
SelectWithContents->True]\)["Battles"]]

You could ask for a timeline of the beginning of the war (you don’t need to say “first 15 battles”, because if one cares, one can just read that from the Wolfram Language code):

TimelinePlot[Take[\!\(\*
NamespaceBox["LinguisticAssistant",
DynamicModuleBox[{Typeset`query$$ = "English Civil War",
       Typeset`boxes$$ = TemplateBox[{"\"English Civil War\"",
RowBox[{"Entity", "[",
RowBox[{"\"MilitaryConflict\"", ",", "\"EnglishCivilWar\""}], "]"}],
         "\"Entity[\\\"MilitaryConflict\\\", \\\"EnglishCivilWar\\\"]\
\"", "\"military conflict\""}, "Entity"],
       Typeset`allassumptions$$ = {{
        "type" -> "Clash", "word" -> "English Civil War",
         "template" -> "Assuming \"${word}\" is ${desc1}. Use as \
${desc2} instead", "count" -> "3",
         "Values" -> {{
           "name" -> "MilitaryConflict",
            "desc" -> "a military conflict",
            "input" -> "*C.English+Civil+War-_*MilitaryConflict-"}, {
           "name" -> "Word", "desc" -> "a word",
            "input" -> "*C.English+Civil+War-_*Word-"}, {
           "name" -> "HistoricalEvent",
            "desc" -> "a historical event",
            "input" -> "*C.English+Civil+War-_*HistoricalEvent-"}}}, {
        "type" -> "SubCategory", "word" -> "English Civil War",
         "template" -> "Assuming ${desc1}. Use ${desc2} instead",
         "count" -> "4",
         "Values" -> {{
           "name" -> "EnglishCivilWar",
            "desc" -> "English Civil War (1642 - 1651)",
            "input" -> "*DPClash.MilitaryConflictE.English+Civil+War-_\
*EnglishCivilWar-"}, {
           "name" -> "FirstEnglishCivilWar",
            "desc" -> "English Civil War (1642 - 1646)",
            "input" -> "*DPClash.MilitaryConflictE.English+Civil+War-_\
*FirstEnglishCivilWar-"}, {
           "name" -> "SecondEnglishCivilWar",
            "desc" -> "Second English Civil War",
            "input" -> "*DPClash.MilitaryConflictE.English+Civil+War-_\
*SecondEnglishCivilWar-"}, {
           "name" -> "ThirdEnglishCivilWar",
            "desc" -> "Third English Civil War",
            "input" -> "*DPClash.MilitaryConflictE.English+Civil+War-_\
*ThirdEnglishCivilWar-"}}}}, Typeset`assumptions$$ = {},
       Typeset`open$$ = {1, 2}, Typeset`querystate$$ = {
       "Online" -> True, "Allowed" -> True,
        "mparse.jsp" -> 1.305362`6.5672759594240935,
        "Messages" -> {}}},
DynamicBox[ToBoxes[
AlphaIntegration`LinguisticAssistantBoxes["", 4, Automatic,
Dynamic[Typeset`query$$],
Dynamic[Typeset`boxes$$],
Dynamic[Typeset`allassumptions$$],
Dynamic[Typeset`assumptions$$],
Dynamic[Typeset`open$$],
Dynamic[Typeset`querystate$$]], StandardForm],
ImageSizeCache->{275., {7., 17.}},
TrackedSymbols:>{
         Typeset`query$$, Typeset`boxes$$, Typeset`allassumptions$$,
          Typeset`assumptions$$, Typeset`open$$,
          Typeset`querystate$$}],
DynamicModuleValues:>{},
UndoTrackedVariables:>{Typeset`open$$}],
BaseStyle->{"Deploy"},
DeleteWithContents->True,
Editable->False,
SelectWithContents->True]\)["Battles"], 15]]

You could start looking at how armies moved, or who won and who lost at different points. At first, you can write a computational essay in which the computations are basically just generating custom infographics to illustrate your narrative. But then you can go further—and start really doing “computational history”. You can start to compute various statistical measures of the progress of the war. You can find ways to quantitatively compare it to other wars, and so on.

Can you make a “computational essay” about art? Absolutely. Maybe about art history. Pick 10 random paintings by van Gogh:




van Gogh paintings output

EntityValue[RandomSample[\!\(\*
NamespaceBox["LinguisticAssistant",
DynamicModuleBox[{Typeset`query$$ = "van gogh", Typeset`boxes$$ =
       TemplateBox[{"\"Vincent van Gogh\"",
RowBox[{"Entity", "[",
RowBox[{"\"Person\"", ",", "\"VincentVanGogh::9vq62\""}], "]"}],
         "\"Entity[\\\"Person\\\", \\\"VincentVanGogh::9vq62\\\"]\"",
         "\"person\""}, "Entity"],
       Typeset`allassumptions$$ = {{
        "type" -> "Clash", "word" -> "van gogh",
         "template" -> "Assuming \"${word}\" is ${desc1}. Use as \
${desc2} instead", "count" -> "4",
         "Values" -> {{
           "name" -> "Person", "desc" -> "a person",
            "input" -> "*C.van+gogh-_*Person-"}, {
           "name" -> "Movie", "desc" -> "a movie",
            "input" -> "*C.van+gogh-_*Movie-"}, {
           "name" -> "SolarSystemFeature",
            "desc" -> "a solar system feature",
            "input" -> "*C.van+gogh-_*SolarSystemFeature-"}, {
           "name" -> "Word", "desc" -> "a word",
            "input" -> "*C.van+gogh-_*Word-"}}}},
       Typeset`assumptions$$ = {}, Typeset`open$$ = {1, 2},
       Typeset`querystate$$ = {
       "Online" -> True, "Allowed" -> True,
        "mparse.jsp" -> 0.472412`6.125865914333281,
        "Messages" -> {}}},
DynamicBox[ToBoxes[
AlphaIntegration`LinguisticAssistantBoxes["", 4, Automatic,
Dynamic[Typeset`query$$],
Dynamic[Typeset`boxes$$],
Dynamic[Typeset`allassumptions$$],
Dynamic[Typeset`assumptions$$],
Dynamic[Typeset`open$$],
Dynamic[Typeset`querystate$$]], StandardForm],
ImageSizeCache->{227., {7., 17.}},
TrackedSymbols:>{
         Typeset`query$$, Typeset`boxes$$, Typeset`allassumptions$$,
          Typeset`assumptions$$, Typeset`open$$,
          Typeset`querystate$$}],
DynamicModuleValues:>{},
UndoTrackedVariables:>{Typeset`open$$}],
BaseStyle->{"Deploy"},
DeleteWithContents->True,
Editable->False,
SelectWithContents->True]\)["NotableArtworks"], 10], "Image"]

Then look at what colors they use (a surprisingly narrow selection):

ChromaticityPlot[%]

ChromaticityPlot[%]

Or maybe one could write a computational essay about actually creating art, or music.

What about science? You could rediscover Kepler’s laws by looking at properties of planets:

\!\(\*
NamespaceBox["LinguisticAssistant",
DynamicModuleBox[{Typeset`query$$ = "planets", Typeset`boxes$$ =
     TemplateBox[{"\"planets\"",
RowBox[{"EntityClass", "[",
RowBox[{"\"Planet\"", ",", "All"}], "]"}],
       "\"EntityClass[\\\"Planet\\\", All]\"", "\"planets\""},
      "EntityClass"],
     Typeset`allassumptions$$ = {{
      "type" -> "Clash", "word" -> "planets",
       "template" -> "Assuming \"${word}\" is ${desc1}. Use as \
${desc2} instead", "count" -> "4",
       "Values" -> {{
         "name" -> "PlanetClass", "desc" -> " referring to planets",
          "input" -> "*C.planets-_*PlanetClass-"}, {
         "name" -> "ExoplanetClass",
          "desc" -> " referring to exoplanets",
          "input" -> "*C.planets-_*ExoplanetClass-"}, {
         "name" -> "MinorPlanetClass",
          "desc" -> " referring to minor planets",
          "input" -> "*C.planets-_*MinorPlanetClass-"}, {
         "name" -> "Word", "desc" -> "a word",
          "input" -> "*C.planets-_*Word-"}}}},
     Typeset`assumptions$$ = {}, Typeset`open$$ = {1, 2},
     Typeset`querystate$$ = {
     "Online" -> True, "Allowed" -> True,
      "mparse.jsp" -> 0.400862`6.054539882441674, "Messages" -> {}}},
DynamicBox[ToBoxes[
AlphaIntegration`LinguisticAssistantBoxes["", 4, Automatic,
Dynamic[Typeset`query$$],
Dynamic[Typeset`boxes$$],
Dynamic[Typeset`allassumptions$$],
Dynamic[Typeset`assumptions$$],
Dynamic[Typeset`open$$],
Dynamic[Typeset`querystate$$]], StandardForm],
ImageSizeCache->{171., {7., 17.}},
TrackedSymbols:>{
       Typeset`query$$, Typeset`boxes$$, Typeset`allassumptions$$,
        Typeset`assumptions$$, Typeset`open$$, Typeset`querystate$$}],
DynamicModuleValues:>{},
UndoTrackedVariables:>{Typeset`open$$}],
BaseStyle->{"Deploy"},
DeleteWithContents->True,
Editable->False,
SelectWithContents->True]\)[{"DistanceFromSun", "OrbitPeriod"}]

ListLogLogPlot[%]

ListLogLogPlot[%]

Maybe you could go on and check it for exoplanets. Or you could start solving the equations of motion for planets.

You could look at biology. Here’s the first beginning of the reference sequence for the human mitochondrion:

GenomeData[{"Mitochondrion", {1, 150}}]

GenomeData[{"Mitochondrion", {1, 150}}]

You can start off breaking it into possible codons:

StringPartition[%, 3]

StringPartition[%, 3]

There’s an immense amount of data about all kinds of things built into the Wolfram Language. But there’s also the Wolfram Data Repository, which contains all sorts of specific datasets. Like here’s a map of state fairgrounds in the US:

GeoListPlot[  ResourceData["U.S. State Fairgrounds"][All, "GeoPosition"]]

GeoListPlot[
 ResourceData["U.S. State Fairgrounds"][All, "GeoPosition"]]

And here’s a word cloud of the constitutions of countries that have been enacted since 2010:

WordCloud[
 StringJoin[
  Normal[ResourceData["World Constitutions"][
    Select[#YearEnacted > \!\(\*
NamespaceBox["LinguisticAssistant",
DynamicModuleBox[{Typeset`query$$ = "year 2010", Typeset`boxes$$ =
           RowBox[{"DateObject", "[",
RowBox[{"{", "2010", "}"}], "]"}],
           Typeset`allassumptions$$ = {{
            "type" -> "MultiClash", "word" -> "",
             "template" -> "Assuming ${word1} is referring to \
${desc1}. Use \"${word2}\" as ${desc2}.", "count" -> "2",
             "Values" -> {{
               "name" -> "PseudoTokenYear", "word" -> "year 2010",
                "desc" -> "a year",
                "input" -> "*MC.year+2010-_*PseudoTokenYear-"}, {
               "name" -> "Unit", "word" -> "year", "desc" -> "a unit",
                 "input" -> "*MC.year+2010-_*Unit-"}}}},
           Typeset`assumptions$$ = {}, Typeset`open$$ = {1},
           Typeset`querystate$$ = {
           "Online" -> True, "Allowed" -> True,
            "mparse.jsp" -> 0.542662`6.186074404594303,
            "Messages" -> {}}},
DynamicBox[ToBoxes[
AlphaIntegration`LinguisticAssistantBoxes["", 4, Automatic,
Dynamic[Typeset`query$$],
Dynamic[Typeset`boxes$$],
Dynamic[Typeset`allassumptions$$],
Dynamic[Typeset`assumptions$$],
Dynamic[Typeset`open$$],
Dynamic[Typeset`querystate$$]], StandardForm],
ImageSizeCache->{86., {7., 18.}},
TrackedSymbols:>{
             Typeset`query$$, Typeset`boxes$$,
              Typeset`allassumptions$$, Typeset`assumptions$$,
              Typeset`open$$, Typeset`querystate$$}],
DynamicModuleValues:>{},
UndoTrackedVariables:>{Typeset`open$$}],
BaseStyle->{"Deploy"},
DeleteWithContents->True,
Editable->False,
SelectWithContents->True]\) &], "Text"]]]]

Quite often one’s interested in dealing not with public data, but with some kind of local data. One convenient source of this is the Wolfram Data Drop. In an educational setting, particular databins (or cloud objects in general) can be set so that they can be read (and/or added to) by some particular group. Here’s a databin that I accumulate for myself, showing my heart rate through the day. Here it is for today:

DataListPlot[TimeSeries[Databin[

DateListPlot[TimeSeries[YourDatabinHere]]

Of course, it’s easy to make a histogram too:

Histogram[TimeSeries[Databin[

Histogram[TimeSeries[YourDatabinHere]]

What about math? A key issue in math is to understand why things are true. The traditional approach to this is to give proofs. But computational essays provide an alternative. The nature of the steps in them is different—but the objective is the same: to show what’s true and why.

As a very simple example, let’s look at primes. Here are the first 50:

Table[Prime[n], {n, 50}]

Table[Prime[n], {n, 50}]

Let’s find the remainder mod 6 for all these primes:

Mod[Table[Prime[n], {n, 50}], 6]

Mod[Table[Prime[n], {n, 50}], 6]

But why do only 1 and 5 occur (well, after the trivial cases of the primes 2 and 3)? We can see this by computation. Any number can be written as 6n+k for some n and k:

Table[6 n + k, {k, 0, 5}]

Table[6 n + k, {k, 0, 5}]

But if we factor numbers written in this form, we’ll see that 6n+1 and 6n+5 are the only ones that don’t have to be multiples:

Factor[%]

Factor[%]

What about computer science? One could for example write a computational essay about implementing Euclid’s algorithm, studying its running time, and so on.

Define a function to give all steps in Euclid’s algorithm:

gcdlist[a_, b_] :=   NestWhileList[{Last[#], Apply[Mod, #]} &, {a, b}, Last[#] != 0 &, 1]

gcdlist[a_, b_] :=
 NestWhileList[{Last[#], Apply[Mod, #]} &, {a, b}, Last[#] != 0 &, 1]

Find the distribution of running lengths for the algorithm for numbers up to 200:

Histogram[Flatten[Table[Length[gcdlist[i, j]], {i, 200}, {j, 200}]]]

Histogram[Flatten[Table[Length[gcdlist[i, j]], {i, 200}, {j, 200}]]]

Or in modern times, one could explore machine learning, starting, say, by making a feature space plot of part of the MNIST handwritten digits dataset:

FeatureSpacePlot[RandomSample[Keys[ResourceData["MNIST"]], 50]]

FeatureSpacePlot[RandomSample[Keys[ResourceData["MNIST"]], 50]]

If you wanted to get deeper into software engineering, you could write a computational essay about the HTTP protocol. This gets an HTTP response from a site:

URLRead["https://www.wolframalpha.com"]

URLRead["https://www.wolfram.com"]

And this shows the tree structure of the elements on the webpage at that URL:

TreeForm[Import["http://www.wolframalpha.com", {"HTML", "XMLObject"}],   VertexLabeling -> False, AspectRatio -> 1/2]

TreeForm[Import["http://www.wolframalpha.com", {"HTML", "XMLObject"}],
  VertexLabeling -> False, AspectRatio -> 1/2]

Or—in a completely different direction—you could talk about anatomy:

AnatomyPlot3D[left foot]

AnatomyPlot3D[Entity["AnatomicalStructure", "LeftFoot"]]

What Makes a Good Computational Essay?

As far as I’m concerned, for a computational essay to be good, it has to be as easy to understand as possible. The format helps quite a lot, of course. Because a computational essay is full of outputs (often graphical) that are easy to skim, and that immediately give some impression of what the essay is trying to say. It also helps that computational essays are structured documents, that deliver information in well-encapsulated pieces.

But ultimately it’s up to the author of a computational essay to make it clear. But another thing that helps is that the nature of a computational essay is that it must have a “computational narrative”—a sequence of pieces of code that the computer can execute to do what’s being discussed in the essay. And while one might be able to write an ordinary essay that doesn’t make much sense but still sounds good, one can’t ultimately do something like that in a computational essay. Because in the end the code is the code, and actually has to run and do things.

So what can go wrong? Well, like English prose, Wolfram Language code can be unnecessarily complicated, and hard to understand. In a good computational essay, both the ordinary text, and the code, should be as simple and clean as possible. I try to enforce this for myself by saying that each piece of input should be at most one or perhaps two lines long—and that the caption for the input should always be just one line long. If I’m trying to do something where the core of it (perhaps excluding things like display options) takes more than a line of code, then I break it up, explaining each line separately.

Another important principle as far as I’m concerned is: be explicit. Don’t have some variable that, say, implicitly stores a list of words. Actually show at least part of the list, so people can explicitly see what it’s like. And when the output is complicated, find some tabulation or visualization that makes the features you’re interested in obvious. Don’t let the “key result” be hidden in something that’s tucked away in the corner; make sure the way you set things up makes it front and center.

Use the structured nature of notebooks. Break up computational essays with section headings, again helping to make them easy to skim. I follow the style of having a “caption line” before each input. Don’t worry if this somewhat repeats what a paragraph of text has said; consider the caption something that someone who’s just “looking at the pictures” might read to understand what a picture is of, before they actually dive into the full textual narrative.

The technology of Wolfram Notebooks makes it straightforward to put in interactive elements, like Manipulate, into computational essays. And sometimes this is very helpful, and perhaps even essential. But interactive elements shouldn’t be overused. Because whenever there’s an element that requires interaction, this reduces the ability to skim the essay.

Sometimes there’s a fair amount of data—or code—that’s needed to set up a particular computational essay. The cloud is very useful for handling this. Just deploy the data (or code) to the Wolfram Cloud, and set appropriate permissions so it can automatically be read whenever the code in your essay is executed.

Notebooks also allow “reverse closing” of cells—allowing an output cell to be immediately visible, even though the input cell that generated it is initially closed. This kind of hiding of code should generally be avoided in the body of a computational essay, but it’s sometimes useful at the beginning or end of an essay, either to give an indication of what’s coming, or to include something more advanced where you don’t want to go through in detail how it’s made.

OK, so if a computational essay is done, say, as homework, how can it be assessed? A first, straightforward question is: does the code run? And this can be determined pretty much automatically. Then after that, the assessment process is very much like it would be for an ordinary essay. Of course, it’s nice and easy to add cells into a notebook to give comments on what’s there. And those cells can contain runnable code—that for example can take results in the essay and process or check them.

Are there principles of good computational essays? Here are a few candidates:

0. Understand what you’re talking about (!)

1. Find the most straightforward and direct way to represent your subject matter

2. Keep the core of each piece of Wolfram Language input to a line or two

3. Use explicit visualization or other information presentation as much as possible

4. Try to make each input+caption independently understandable

5. Break different topics or directions into different subsections

Learning the Language

At the core of computational essays is the idea of expressing computational thoughts using the Wolfram Language. But to do that, one has to know the language. Now, unlike human languages, the Wolfram Language is explicitly designed (and, yes, that’s what I’ve been doing for the past 30+ years) to follow definite principles and to be as easy to learn as possible. But there’s still learning to be done.

One feature of the Wolfram Language is that—like with human languages—it’s typically easier to read than to write. And that means that a good way for people to learn what they need to be able to write computational essays is for them first to read a bunch of essays. Perhaps then they can start to modify those essays. Or they can start creating “notes essays”, based on code generated in livecoding or other classroom sessions.

As people get more fluent in writing the Wolfram Language, something interesting happens: they start actually expressing themselves in the language, and using Wolfram Language input to carry significant parts of the narrative in a computational essay.

When I was writing An Elementary Introduction to the Wolfram Language (which itself is written in large part as a sequence of computational essays) I had an interesting experience. Early in the book, it was decently easy to explain computational exercises in English (“Make a table of the first 10 squares”). But a little later in the book, it became a frustrating process.

It was easy to express what I wanted in the Wolfram Language. But to express it in English was long and awkward (and had a tendency of sounding like legalese). And that’s the whole point of using the Wolfram Language, and the reason I’ve spent 30+ years building it: because it provides a better, crisper way to express computational thoughts.

It’s sometimes said of human languages that the language you use determines how you think. It’s not clear how true this is of human languages. But it’s absolutely true of computer languages. And one of the most powerful things about the Wolfram Language is that it helps one formulate clear computational thinking.

Traditional computer languages are about writing code that describes the details of what a computer should do. The point of the Wolfram Language is to provide something much higher level—that can immediately talk about things in the world, and that can allow people as directly as possible to use it as a medium of computational thinking. And in a sense that’s what makes a good computational essay possible.

The Long Path to Computational Essays

Now that we have full-fledged computational essays, I realize I’ve been on a path towards them for nearly 40 years. At first I was taking interactive computer output and Scotch-taping descriptions into it:

Interactive computer output sketch

By 1981, when I built SMP, I was routinely writing documents that interspersed code and explanations:

Code interspersed with explanations

But it was only in 1986, when I started documenting what became Mathematica and the Wolfram Language, that I started seriously developing a style close to what I now favor for computational essays:

Wolfram Language Version 1 documentation

And with the release of Mathematica 1.0 in 1988 came another critical element: the invention of Wolfram Notebooks. Notebooks arrived in a form at least superficially very similar to the way they are today (and already in many ways more sophisticated than the imitations that started appearing 25+ years later!): collections of cells arranged into groups, and capable of containing text, executable code, graphics, etc.

Early Mac notebooks

At first notebooks were only possible on Mac and NeXT computers. A few years later they were extended to Microsoft Windows and X Windows (and later, Linux). But immediately people started using notebooks both to provide reports about they’d done, and to create rich expository and educational material. Within a couple of years, there started to be courses based on notebooks, and books printed from notebooks, with interactive versions available on CD-ROM at the back:

Notebook publication example

So in a sense the raw material for computational essays already existed by the beginning of the 1990s. But to really make computational essays come into their own required the development of the cloud—as well as the whole broad range of computational knowledge that’s now part of the Wolfram Language.

By 1990 it was perfectly possible to create a notebook with a narrative, and people did it, particularly about topics like mathematics. But if there was real-world data involved, things got messy. One had to make sure that whatever was needed was appropriately available from a distribution CD-ROM or whatever. We created a Player for notebooks very early, that was sometimes distributed with notebooks.

But in the last few years, particularly with the development of the Wolfram Cloud, things have gotten much more streamlined. Because now you can seamlessly store things in the cloud and use them anywhere. And you can work directly with notebooks in the cloud, just using a web browser. In addition, thanks to lots of user-assistance innovations (including natural language input), it’s become even easier to write in the Wolfram Language—and there’s ever more that can be achieved by doing so.

And the important thing that I think has now definitively happened is that it’s become lightweight enough to produce a good computational essay that it makes sense to do it as something routine—either professionally in writing reports, or as a student doing homework.

Ancient Educational History

The idea of students producing computational essays is something new for modern times, made possible by a whole stack of current technology. But there’s a curious resonance with something from the distant past. You see, if you’d learned a subject like math in the US a couple of hundred years ago, a big thing you’d have done is to create a so-called ciphering book—in which over the course of several years you carefully wrote out the solutions to a range of problems, mixing explanations with calculations. And the idea then was that you kept your ciphering book for the rest of your life, referring to it whenever you needed to solve problems like the ones it included.

Well, now, with computational essays you can do very much the same thing. The problems you can address are vastly more sophisticated and wide-ranging than you could reach with hand calculation. But like with ciphering books, you can write computational essays so they’ll be useful to you in the future—though now you won’t have to imitate calculations by hand; instead you’ll just edit your computational essay notebook and immediately rerun the Wolfram Language inputs in it.

I actually only learned about ciphering books quite recently. For about 20 years I’d had essentially as an artwork a curious handwritten notebook (created in 1818, it says, by a certain George Lehman, apparently of Orwigsburg, Pennsylvania), with pages like this:

Ciphering book

I now know this is a ciphering book—that on this page describes how to find the “height of a perpendicular object… by having the length of the shadow given”. And of course I can’t resist a modern computational essay analog, which, needless to say, can be a bit more elaborate.

Find the current position of the Sun as azimuth, altitude:

SunPosition[]

SunPosition[]

Find the length of a shadow for an object of unit height:

1/Tan[SunPosition[][[2]]]

1/Tan[SunPosition[][[2]]]

Given a 10-ft shadow, find the height of the object that made it:

Tan[SunPosition[][[2]]]10ft

Tan[SunPosition[][[2]]]10ft

The Path Ahead

I like writing textual essays (such as blog posts!). But I like writing computational essays more. Because at least for many of the things I want to communicate, I find them a purer and more efficient way to do it. I could spend lots of words trying to express an idea—or I can just give a little piece of Wolfram Language input that expresses the idea very directly and shows how it works by generating (often very visual) output with it.

When I wrote my big book A New Kind of Science (from 1991 to 2002), neither our technology nor the world was quite ready for computational essays in the form in which they’re now possible. My research for the book filled thousands of Wolfram Notebooks. But when it actually came to putting together the book, I just showed the results from those notebooks—including a little of the code from them in notes at the back of the book.

But now the story of the book can be told in computational essays—that I’ve been starting to produce. (Just for fun, I’ve been livestreaming some of the work I’m doing to create these.)  And what’s very satisfying is just how clearly and crisply the ideas in the book can be communicated in computational essays.

There is so much potential in computational essays. And indeed we’re now starting the project of collecting “topic explorations” that use computational essays to explore a vast range of topics in unprecedentedly clear and direct ways. It’ll be something like our Wolfram Demonstrations Project (that now has 11,000+ Wolfram Language–powered Demonstrations). Here’s a typical example I wrote:

The Central Limit Theorem

Computational essays open up all sorts of new types of communication. Research papers that directly present computational experiments and explorations. Reports that describe things that have been found, but allow other cases to be immediately explored. And, of course, computational essays define a way for students (and others) to very directly and usefully showcase what they’ve learned.

There’s something satisfying about both writing—and reading—computational essays. It’s as if in communicating ideas we’re finally able to go beyond pure human effort—and actually leverage the power of computation. And for me, having built the Wolfram Language to be a computational communication language, it’s wonderful to see how it can be used to communicate so effectively in computational essays.

It’s so nice when I get something sent to me as a well-formed computational essay. Because I immediately know that I’m going to get a straight story that I can actually understand. There aren’t going to be all sorts of missing sources and hidden assumptions; there’s just going to be Wolfram Language input that stands alone, and that I can take out and study or run for myself.

The modern world of the web has brought us a few new formats for communication—like blogs, and social media, and things like Wikipedia. But all of these still follow the basic concept of text + pictures that’s existed since the beginning of the age of literacy. With computational essays we finally have something new—and it’s going to be exciting to see all the things it makes possible.

]]>
http://blog.wolfram.com/2017/11/14/what-is-a-computational-essay/feed/ 0
Building the Automated Data Scientist: The New Classify and Predict http://blog.wolfram.com/2017/10/10/building-the-automated-data-scientist-the-new-classify-and-predict/ http://blog.wolfram.com/2017/10/10/building-the-automated-data-scientist-the-new-classify-and-predict/#comments Tue, 10 Oct 2017 16:43:19 +0000 Etienne Bernard http://blog.internal.wolfram.com/?p=38653 Automated Data Science

Imagine a baker connecting a data science application to his database and asking it, “How many croissants are we going to sell next Sunday?” The application would simply answer, “According to your recorded data and other factors such as the predicted weather, there is a 90% chance that between 62 and 67 croissants will be sold.” The baker could then plan accordingly. This is an example of an automated data scientist, a system to which you could throw arbitrary data and get insights or predictions in return.

One key component in making this a reality is the ability to learn a predictive model without specifications from humans besides the data. In the Wolfram Language, this is the role of the functions Classify and Predict. For example, let’s train a classifier to recognize morels from hedgehog mushrooms:

c = Classify[{

We can now use the resulting ClassifierFunction on new examples:

c[

c[

And we can obtain a probability for each possibility:
c[

As another example, let’s train a PredictorFunction to predict the average monthly temperature for some US cities:

data = RandomSample[ResourceData["Sample Data: US City Temperature"]]

p = Predict[data ->

Again, we can use the resulting function to make a prediction:

p[<|

And we can obtain a distribution of predictions:

dist = p[<|

As can you see, Classify and Predict do not need to be told what the variables are, what preprocessing to perform or which algorithm to use: they are automated functions.

New Classify and Predict

We introduced Classify and Predict in Version 10 of the Wolfram Language (about three years ago), and have been happy to see it used in various contexts (my favorite involves an astronaut, a plane and a Raspberry Pi). In Version 11.2, we decided to give these functions a complete makeover. The most visible update is the introduction of an information panel in order to get feedback during the training:

Classify progress animation

With it, one can monitor things such as the current best method and the current accuracy, and one can get an idea of how long the training will be—very useful in deciding if it is worth continuing or not! If one wants to stop the training, there are two ways to do it: either with the Stop button or by directly aborting the evaluation. In both cases, the best model that Classify and Predict came up with so far is returned (but the Stop interruption is softer: it waits until the current training is over).

A similar panel is now displayed when using ClassifierInformation and PredictorInformation on a classifier or a predictor:

Classify set 1

We tried to show some useful information about the model, such as its accuracy (on a test set), the time it takes to evaluate new examples and its memory size. More importantly, you can see a “learning curve” on the bottom that shows the value of the loss (the measure that one is trying to minimize) as a function of the number of examples that have been used for training. By pressing the left/right arrows, one can also look at other curves, such as the accuracy as a function of the number of training examples:

Classify set 2

Such curves are useful in figuring out if one needs more data to train on or not (e.g. when the curves are plateauing). We hope that giving easy access to them will ease the modeling workflow (for example, it might reduce the need to use ClassifierMeasurements and PredictorMeasurements).

An important update is the addition of the TimeGoal option, which allows one to specify how long one wishes the training to take, e.g:

c = Classify[{1, 2, 3, 4} -> {

ClassifierInformation[c,

TimeGoal has a different meaning than TimeConstraint: it is not about specifying a maximum amount of time, but really a goal that should be reached. Setting a higher time goal allows the automation system to try additional things in order to find a better model. In my opinion, this makes TimeGoal the most important option of both Classify and Predict (followed by Method and PerformanceGoal).

On the method side, things have changed as well. Each method now has its own documentation page ("LogisticRegression", "NearestNeighbors", etc.) that gives generic information and allows experts to play with the options that are described. We also added two new methods: "DecisionTree" and, more noticeably, "GradientBoostedTrees", which is a favorite of data scientists. Here is a simple prediction example:

data = # -> Sin[2 #] + Cos[#] + RandomReal[] & /@ RandomReal[10, 200];

p = Predict[data, Method ->
Show[ListPlot[List @@@ data, PlotStyle -> Gray, PlotLegends -> {

Under the Hood…

OK, let’s now get to the main change in Version 11.2, which is not directly visible: we reimplemented the way Classify and Predict determine the optimal method and hyperparameters for a given dataset (in a sense, the core of the automation). For those who are interested, let me try to give a simple explanation of how this procedure works for Classify.

A classifier needs to be trained using a method (e.g. "LogisticRegression", "RandomForest", etc.) and each method needs to be given some hyperparameters (such as "L2Regularization" or "NeighborsNumber"). The automation procedure is there to figure out the best configuration (i.e. the best method + hyperparameters) to use according to how well the classifier (trained with this configuration) performs on a test set, but also how fast or how small in memory the classifier is. It is hard to know if a given configuration would perform well without actually training and testing it. The idea of our procedure is to start with many configurations that we believe could perform well (let’s say 100), then train these configurations on small datasets and use the information gathered during these “experiments” to predict how well the configurations would perform on the full dataset. The predictions are not perfect, but they are useful in selecting a set of promising configurations that will be trained on larger datasets in order to gather more information (you might notice some similarities with the Hyperband procedure). This operation is repeated until only a few configurations (sometimes even just one) are trained on the full dataset. Here is a visualization of the loss function for some configurations (each curve represents a different one) that underwent this operation:
Training graph

As you can see, many configurations have been trained on 10 and 40 examples, but just a few of them on 200 examples, and only one of them on 800 examples. We found in our benchmarks that the final configuration obtained is often the optimal one (among the ones present in the initial configuration set). Also, since training on smaller datasets is faster, the time needed for the entire procedure is not much greater than the time needed to train one configuration on the full dataset, which, as you can imagine, is much faster than training all configurations on the full dataset!

Besides being faster than the previous version, this automation strategy was necessary to bring some of the capabilities that I presented above. For example, the procedure directly produces an estimation of model performances and learning curves. Also, it enables the display of a progress bar and quickly produces valid models that can be returned if the Stop button is pressed. Finally, it enables the introduction of the TimeGoal option by adapting the number of intermediate trainings depending on the amount of time available.

We hope that you will find ways to use this new version of Classify and Predict. Don’t hesitate to give us feedback. The road to a fully automated data scientist is still long, but we’re getting closer!


Download this post as a Computable Document Format (CDF) file. New to CDF? Get your copy for free with this one-time download.

]]>
http://blog.wolfram.com/2017/10/10/building-the-automated-data-scientist-the-new-classify-and-predict/feed/ 2