 1. New in the Wolfram Language: FindTextualAnswerЧт., 15 февр.[−]
Are you ever certain that somewhere in a text or set of texts, the answer to a pressing question is waiting to be found, but you don t want to take the time to skim through thousands of words to find what you re looking for? Well, soon the Wolfram Language will provide concise answers to your specific, factbased questions directed toward an unstructured collection of texts (with a technology very different from that of WolframAlpha, which is based on a carefully curated knowledgebase).
Let s start with the essence of FindTextualAnswer. This feature, available in the upcoming release of the Wolfram Language, answers questions by quoting the most appropriate excerpts of a text that is presumed to contain the relevant information.
?
FindTextualAnswer["Lake Titicaca is a large, deep lake in the Andes \
on the border of Bolivia and Peru. By volume of water and by surface \
area, it is the largest lake in South America", "Where is Titicaca?"]
FindTextualAnswer can mine Wikipedia a convenient source of continuously refreshed knowledge for answers to your questions. Let s use WikipediaData!
?
bandArticle = WikipediaData["The Who"];
Snippet[bandArticle]
?
FindTextualAnswer[bandArticle, "Who founded the Who?"]
FindTextualAnswer can yield several possible answers, the probabilities of those answers being correct and other properties that can help you understand the context of each answer:
?
FindTextualAnswer[bandArticle, "Who founded the Who?",
3, {"Probability", "HighlightedSentence"}] // TableForm
FindTextualAnswer can efficiently answer several questions about the same piece of text:
?
text = "Even thermometers can't keep up with the plunging \
temperatures in Russia's remote Yakutia region, which hit minus 88.6 \
degrees Fahrenheit in some areas Tuesday. In Yakutia  a region of 1 \
million people about 3,300 miles east of Moscow  students routinely \
go to school even in minus 40 degrees. But school was cancelled \
Tuesday throughout the region and police ordered parents to keep \
their children inside.
In the village of Oymyakon, one of the coldest inhabited places on \
earth, stateowned Russian television showed the mercury falling to \
the bottom of a thermometer that was only set up to measure down to \
minus 50 degrees. In 2013, Oymyakon recorded an alltime low of minus \
98 Fahrenheit.";
questions = {"What is the temperature in Yakutia?",
"Name one of the coldest places on earth?",
"When was the lowest temperature recorded in Oymyakon?",
"Where is Yakutia?",
"How many live in Yakutia?",
"How far is Yakutia from Moscow?"};
Thread[questions > FindTextualAnswer[text, questions]] // Column
Because FindTextualAnswer is based on statistical methods, asking the same question in different ways can provide different answers:
?
cityArticle = WikipediaData["Bras?lia"];
Snippet[cityArticle]
?
questions = {"Brasilia was inaugurated when?",
"When was Brasilia finally constructed?"};
FindTextualAnswer[cityArticle, questions, 3, {"Probability",
"HighlightedSentence"}]
The answers to similar questions found in different pieces of text can be merged and displayed nicely in a WordCloud:
?
WordCloud[
Catenate[FindTextualAnswer[cityArticle, questions,
5, {"String", "Probability"}]], WordSpacings > {10, 4},
ColorFunction > "TemperatureMap"]
Any specialized textual knowledge database can be given to FindTextualAnswer. It can be a set of local files, a URL, a textual resource in the Wolfram Data Repository, the result of a TextSearch or a combination of all of these:
?
FindTextualAnswer[{File["ExampleData/USConstitution.txt"],
WikipediaData[
"US Constitutional Law"]}, "which crimes are punished in the US \
Constitution?", 5]
?
FindTextualAnswer[texts, "which crimes are punished in the US \
Constitution?", 5]
FindTextualAnswer is good, but not perfect. It can occasionally make silly, sometimes funny or inexplicable mistakes. You can see why it is confused here:
?
question = "Who is Raoul?";
context = ResourceData["The Phantom of the Opera"];
FindTextualAnswer[context, question, 1,
"HighlightedSentence"] // First
We will keep on improving the underlying statistical model in the next versions.
Under the Hood
FindTextualAnswer combines wellestablished techniques for information retrieval and stateoftheart deep learning techniques to find answers in a text.
If a significant number of paragraphs is given to FindTextualAnswer, it first selects the closest ones to the question. The distance is based on a term frequency–inverse term frequency (TFIDF) weighting of the matching terms, similar to the following lines of code:
?
corpus = WikipediaData["Rhinoceros"];
passages = TextCases[corpus, "Sentence"];
?
tfidf = FeatureExtraction[passages, "TFIDF"];
?
question = "What are the horns of a rhinoceros made of?";
?
TakeSmallestBy[passages, CosineDistance[tfidf@#, tfidf@question] , 2]
The TFIDFbased selection allows us to discard a good amount of irrelevant passages of text and spend more expensive computations to locate more precisely the answer(s) within a subset of candidate paragraphs:
?
FindTextualAnswer[corpus, question, 2,
"HighlightedSentence"] // Column
This finer detection of the answer is done by a deep artificial neural network inspired by the cuttingedge deep learning techniques for question answering.
The neural network at the core of FindTextualAnswer was constructed, trained and deployed using the Wolfram neural network capabilities, primarily NetGraph, NetTrain and NetModel. The network is shown in the following directed graph of layers:
?
net = NetModel["Wolfram FindTextualAnswer Net for WL 11.3"]
?
net = NetModel["Wolfram FindTextualAnswer Net for WL 11.3"]
This network was first developed using the Stanford Question Answering Dataset (SQuAD) before using similarly labeled data from various domains and textual sources of knowledge, including the knowledgebase used to power WolframAlpha. Each training sample is a tuple with a paragraph of text, a question and the position of the answer in the paragraph. The current neural network takes as input a sequence of tokens, where each token can be a word, a punctuation mark or any symbol in the text. As the network was trained to output a unique span, the positions of the answers are given as start and end indices of these tokens, as in the tokenized version of the SQuAD dataset in the Wolfram Data Repository. A single training sample is shown here:
?
ResourceData["SQuAD v1.1 Tokens Generated with WL",
"TrainingData"][[All, 14478]]
Several types of questions and answers are used to train; these can be classified as follows for the SQuAD dataset:
The following chart shows the different components of the network and their roles in understanding the input text in light of the question:
A first part encodes all the words in the context and the question in a semantic space. It mainly involves two deep learning goodies: (1) word embeddings that map each word in a semantic vector space, independent of the other words in the text; and (2) a bidirectional recurrent layer to get the semantics of the words in context.
The embeddings already capture a lot about the semantics putting together synonyms and similar concepts as illustrated below using FeatureSpacePlot to show the computed semantic relationships among fruits, animals and colors.
?
animals = {"Alligator", "Bear", Sequence[
"Bird", "Bee", "Camel", "Zebra", "Crocodile", "Rhinoceros",
"Giraffe", "Dolphin", "Duck", "Eagle", "Elephant", "Fish", "Fly"]};
colors = {"Blue", "White", Sequence[
"Yellow", "Purple", "Red", "Black", "Green", "Grey"]};
fruits = {"Apple", "Apricot", Sequence[
"Avocado", "Banana", "Blackberry", "Cherry", "Coconut", "Cranberry",
"Grape", "Mango", "Melon", "Papaya", "Peach", "Pineapple",
"Raspberry", "Strawberry", "Fig"]}; FeatureSpacePlot[
Join[animals, colors, fruits],
FeatureExtractor >
NetModel["GloVe 300Dimensional Word Vectors Trained on Wikipedia \
and Gigaword 5 Data"]]
Word embeddings have been a key ingredient in natural language processing since 2013. Several embeddings are available in the Wolfram Neural Net Repository. The current model in FindTextualAnswer is primarily based on GloVe 300Dimensional Word Vectors Trained on Wikipedia and Gigaword 5 Data.
A second part of the neural network produces a higherlevel representation that takes into account the semantic matching between different passages of the text and the question. This part uses yet another powerful deep learning ingredient, called attention, that is particularly suited for natural language processing and the processing of sequences in general. The attention mechanism assigns weights to all words and uses them to compute a weighted representation. Like most of the stateoftheart models of question answering, the neural network of FindTextualAnswer uses a twoway attention mechanism. The words of the question focus attention on the passage and the words of the passage focus attention on the question, meaning that the network exploits both a questionaware representation of the text and a contextaware representation of the question. This is similar to what you would do when answering a question about a text: first you read the question, then read the text with the question in mind (and possibly reinterpret the question), then focus on the relevant pieces of information in the text.
Let s illustrate how encoding and attention work on a simple input example:
?
question = "What colour are elephants?";
context = "Elephants have a grey or white skin.";
The network is fed with the list of tokens from the context and the question:
?
getTokens =
StringSplit[#, {WhitespaceCharacter,
x : PunctuationCharacter :> x}] ;
input = getTokens@context,
"Question" > getTokens@question,
"WordMatch" > Join[{{0, 1, 1}}, ConstantArray[0, {7, 3}]]>
Note that this input includes a vector "WordMatch" that indicates for each word of the context if it occurs in the question under a certain form. For instance, here the word Elephants is matched if we ignore the case. The goal of this tailored feature is to cope with outofvocabulary words, i.e. with words that are not in the word embeddings dictionary (their embedding will be a vector full of zeros).
The encoding of the text and the question are computed by two subparts of the full network. These intermediate representations can be extracted as follows:
?
questionEncoded = net[input, NetPort["encode_question", "Output"]];
?
questionEncoded = net[input, NetPort["encode_question", "Output"]];
?
contextEncoded = net[input, NetPort["encode_context", "Output"]];
?
contextEncoded = net[input, NetPort["encode_context", "Output"]];
Each encoding consists of one vector per word, and is therefore a sequence of vectors for a full text or question. These sequences of numbers are hardly interpretable per se, and would just be perceived as noise by an average human being. Yes, artificial neural networks are kind of black boxes.
The attention mechanism is based on a similarity matrix that is just the outer dot product of these two representations:
?
outerProduct = Outer[Dot, questionEncoded, contextEncoded, 1];
This similarity matrix is normalized using a SoftmaxLayer. Each word of the question focuses attention on the text, with a row of weights that sum up to 1:
?
outerProduct = Outer[Dot, questionEncoded, contextEncoded, 1];
Each word of the text also focuses attention on the question with a set of weights that are this time obtained by normalizing the columns:
?
outerProduct = Outer[Dot, questionEncoded, contextEncoded, 1];
Finally, the network builds upon the joint contextquestion representation, again with recurrent layers aggregating evidence to produce a higherlevel internal representation. And finally, a last part of the network assigns probabilities for each possible selection of text. The outputs of the network are then two distributions of probabilities in the position of, respectively, the start and the end of the answer:
?
netOutput = net[input];
probas = Flatten /@ KeyTake[netOutput, {"Start", "End"}];
ListPlot[probas, FrameTicks > {ticksContext, Automatic},
Filling > Axis, Joined > True, PlotTheme > "Web",
PlotStyle > {Blue, Red}, PlotRange > {0, 1}]
The most probable answer spans are then chosen using a beam search.
These posterior probabilities are based on the assumptions that: (1) the answer is in the context; and (2) there is a unique answer. Therefore, they are not suited to estimate the probability that the answer is right. This probability is computed differently, using a logistic regression on a few intermediate activations of the network at the start and end positions. These activations are accessible through some output NetPort of the network that we named "StartActivation" and "EndActivation":
?
{startActivations, endActivations} =
netOutput /@ {"StartActivation", "EndActivation"};
Logistic regression can be expressed as a shallow neural network with just one linear layer and a LogisticSigmoid function:
?
scorer = NetModel["Wolfram FindTextualAnswer Scorer Net for WL 11.3"]
In the current example, the positions of the answers grey, white and grey or white are given by:
?
positions = {4, 6}, "grey" > {4, 4},
"white" > {6, 6}>;
Then their probabilities can be obtained by accessing the intermediate activations at these positions and applying the logistic regression model:
?
Map[scorer@
Join[startActivations[[First@#]],
endActivations[[Last@#]]] , positions]
Now look at how the network takes into account some additional nuance in the input statement. With the word sometimes, the probability of the subsequent word white drops:
?
context2 = "Elephants have a grey or sometimes white skin.";
So Try It Out!
FindTextualAnswer is a promising achievement of deep learning in the Wolfram Language that mines knowledge in unstructured texts written in natural language. The approach is complementary to the principle of WolframAlpha, which consists of querying a structured knowledge database that is carefully curated, updated and tuned with a unique magical sauce. FindTextualAnswer is different, and enables you to use any personal or specialized unstructured text source. It can, for example, search for the answer to a question of yours in a long history of emails.
If you d like to work with the code you read here today, you can download this post as a Wolfram Notebook.  ↑ 
2. Wolfram News Roundup: Neural Net Connectivity, Gravitational Wave Discoveries and MoreЧт., 08 февр.[−]
It’s been an exciting beginning to the new year here at Wolfram Research with the coming release of Version 11.3 of the Wolfram Language, a soft announcement of the Wolfram Neural Net Repository and our launch of multiparadigm data science.
As part of the new year, we’re also launching some new content in the Public Relations department. As you may have seen, each month we are highlighting the accomplishments of our members on Wolfram Community. We are also recapping news and events about Wolfram each month. So, in case you missed the latest, check out these news stories:
Taliesin Beynon and Sebastian Bodenstein in our Advanced Research Group recently authored a guest post for O’Reilly Media’s Ideas blog about the use of Apache MXNet in the Wolfram Language, providing a behindthescenes glimpse of a highlevel deep learning framework.
“The aim of this post will be threefold: to explain why MXNet was chosen as a back end, to show how the Wolfram Language neural net framework and MXNet can interoperate and, finally, to explain in some technical detail how Wolfram Language uses MXNet to train nets that take sequences of arbitrary length.”
The post details what went into implementing MXNet connectivity in the Wolfram Language as part of the framework for neural networks and deep learning. Read more.
Wolfram Research, NVIDIA and the National Center for Supercomputing Applications just announced breakthrough research in gravitational wave detection. Daniel George, Wolfram Summer School alum and a Wolfram intern, along with his coauthor Eliu Huerta, have published their work in Physics Letters B, outlining the use of deep learning for realtime gravitational wave discovery. Daniel used the Wolfram Language to build the deep learning framework called Deep Filtering. Read more.
Mental Floss published a piece about Theo Gray, cofounder of Wolfram Research and primary developer of the Wolfram Notebook interface way back in 1988. Theo is trained as a chemist and built the Periodic Table Table, which sits on the fifth floor here at Wolfram HQ. It is quite literally a table shaped like the periodic table, with slots for each element—even radioactive ones! Theo is also an accomplished author, and even has his hands in quilting at PaleGray Labs. Read more.
Last summer, we noticed something peculiar. A train station in Cambridge, UK, was getting some attention on Twitter for its unusual facade. Keen observers noticed that the train station appeared to be clad with Wolfram automata. When our CEO Stephen Wolfram caught wind of it, he did some investigating in the Wolfram Language and quickly discovered that “ oh my gosh, it’s covered in rule 30s!” He even prototyped a cellular automata architectural panel generator for users to build their own designs. Read more.
For more updates, be sure to follow us on Twitter, and you can also check us out on Facebook.  ↑ 
3. Cultivating New Solutions for the OrchardPlanting ProblemПт., 02 февр.[−]
Some trees are planted in an orchard. What is the maximum possible number of distinct lines of three trees? In his 1821 book Rational Amusement for Winter Evenings, J. Jackson put it this way:
Fain would I plant a grove in rows
But how must I its form compose
With three trees in each row;
To have as many rows as trees;
Now tell me, artists, if you please:
Tis all I want to know.
Those familiar with tictactoe, threeinarow might wonder how difficult this problem could be, but it’s actually been looked at by some of the most prominent mathematicians of the past and present. This essay presents many new solutions that haven’t been seen before, shows a general method for finding more solutions and points out where current best solutions are improvable.
Various classic problems in recreational mathematics are of this type:
Plant 7 trees to make 6 lines of 3 trees.
Plant 8 trees to make 7 lines of 3 trees.
Plant 9 trees to make 10 lines of 3 trees.
Plant 10 trees to make 12 lines of 3 trees.
Plant 11 trees to make 16 lines of 3 trees.
Here is a graphic for the last problem, 11 trees with 16 lines of 3 trees. Subsets[points,{3}] collects all sets of 3 points. Abs[Det[Append[#,1] /@#]] calculates the triangle area of each set. The sets with area 0 are the lines.
Module[{points, lines},
points = {{1, 1}, {1, 1}, {1, 2 + Sqrt[5]}, {0, 1}, {0, 0}, {0,
1/2 (1 + Sqrt[5])}, {1, 1}, {1,
1}, {1, 2 + Sqrt[5]}, {(1/Sqrt[5]), 1 + 2/Sqrt[5]}, {1/Sqrt[
5], 1 + 2/Sqrt[5]}};
lines = Select[Subsets[points, {3}],
Abs[Det[Append[#, 1] /@ #]] == 0 ];
Graphics[{EdgeForm[{Black, Thick}], Line[#] /@ lines, White,
Disk[#, .1] /@ points}, ImageSize > 540]]
This solution for 12 points matches the known limit of 19 lines, but uses simple integer coordinates and seems to be new. Lines are found with GatherBy and RowReduce, which quickly find a canonical line form for any 2 points in either 2D or 3D space.
Module[{name, root, vals, points, lines, lines3, lines2g},
name = "12 Points in 19 Lines of Three";
points = {{0, 0}, {6, 6}, {6, 6}, {2, 6}, {2, 6}, {6,
6}, {6, 6}, {6, 0}, {6, 0}, {0, 3}, {0, 3}};
lines = Union[Flatten[#, 1]] /@
GatherBy[Subsets[points, {2}], RowReduce[Append[#, 1] /@ #] ];
lines3 = Select[lines, Length[#] == 3 ];
lines2g = Select[lines, Length[#] == 2
(#[[2, 2]]  #[[1, 2]])/(#[[2, 1]]  #[[1, 1]]) == (3/2) ];
Text@Column[{name,
Row[{"Point ", Style["\[FilledCircle]", Green, 18],
" at infinity"}],
Graphics[{Thick, EdgeForm[Thick], Line[Sort[#]] /@ lines3,
Green, InfiniteLine[#] /@ lines2g, { White, Disk[#, .5] } /@
points}, ImageSize > 400,
PlotRange > {{7, 7}, {7, 7}} ]}, Alignment > Center]]
This blog goes far beyond those old problems. Here s how 27 points can make 109 lines of 3 points. If you d like to see the bestknown solutions for 7 to 27 points, skip to the gallery of solutions at the end. For the math, code and methodology behind these solutions, keep reading.
With[{n = 27},
Quiet@zerosumGraphic[
If[orchardsolutions[[n, 2]] > orchardsolutions[[n, 3]],
orchardsolutions[[n, 6]],
Quiet@zerotripsymm[orchardsolutions[[n, 4]], Floor[(n  1)/2]]],
n, {260, 210} 2]]
What is the behavior as the number of trees increases? MathWorld s orchardplanting problem, Wikipedia s orchardplanting problem and the OnLine Encyclopedia of Integer Sequences sequence \"Italic\"]\)\!\(\*
StyleBox[\" \",\nFontSlant>\"Italic\"]\)", " lines ", Row[
{" triples with zero sum (mod \!\(\*
StyleBox[\"p\",\nFontSlant>\"Italic\"]\)) with \!\(\*
StyleBox[\"red\",\nFontColor>RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\" \",\nFontColor>RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\"negative\",\nFontColor>RGBColor[1, 0, 0]]\), \!\(\*
StyleBox[\"green\",\nFontColor>RGBColor[0, 1, 0]]\)\!\(\*
StyleBox[\" \",\nFontColor>RGBColor[0, 1, 0]]\)\!\(\*
StyleBox[\"zero\",\nFontColor>RGBColor[0, 1, 0]]\) and \!\(\*
StyleBox[\"blue\",\nFontColor>RGBColor[0, 0, 1]]\)\!\(\*
StyleBox[\" \",\nFontColor>RGBColor[0, 0, 1]]\)\!\(\*
StyleBox[\"positive\",\nFontColor>RGBColor[0, 0, 1]]\)"}]}],
Spacings > {0, 0}, Frame > All]
Here s a clearer graphic for how this works. Pick three different numbers from 8 to 8 that have a sum of zero. You will find that those numbers are on a straight line. The method used to place these numbers will come later.
That s not the maximum possible number of lines. By moving these points some, the triples that have a modulus17 sum of zero can also be lines. One example is 4 + 6 + 7 = 17.
With[{n = 17},
Quiet@zerosumGraphic[
If[orchardsolutions[[n, 2]] > orchardsolutions[[n, 3]],
orchardsolutions[[n, 6]],
Quiet@zerotripsymm[orchardsolutions[[n, 4]], Floor[(n  1)/2]]],
n, {260, 210} 2]]
Does this method always give the best solution? No—there are at least four sporadic exceptions. Whether any other sporadic solutions exist is not known.
Grid[Partition[
zerosumGraphic[orchardsolutions[[#, 6]], #, {260, 210}] /@ {7, 11,
16, 19}, 2]]
More Than Three in a Row
There are also problems with more than three in a row.
Plant 16 trees to make 15 lines of 4 trees.
Plant 18 trees to make 18 lines of 4 trees.
Plant 25 trees in 18 lines of 5 points.
Plant 112 trees in 3D to make 27 lines of 7 trees.
Fifteen lines of four points using 15 points is simple enough. RowReduce is used to collect lines, with RootReduce added to make sure everything is in a canonical form.
Module[{pts, lines},
pts = Append[
Join[RootReduce[Table[{Sin[2 Pi n/5], Cos[2 Pi n/5]}, {n, 0, 4}]],
RootReduce[
1/2 (3  Sqrt[5]) Table[{Sin[2 Pi n/5], Cos[2 Pi n/5]}, {n, 0,
4}]], RootReduce[(1/2 (3  Sqrt[5]))^2 Table[{Sin[2 Pi n/5],
Cos[2 Pi n/5]}, {n, 0, 4}]]], {0, 0}];
lines = Union[Flatten[#, 1]] /@
Select[SplitBy[
SortBy[Subsets[pts, {2}],
RootReduce[RowReduce[Append[#, 1] /@ #]] ],
RootReduce[RowReduce[Append[#, 1] /@ #]] ], Length[#] > 3 ];
Graphics[{Thick, Line /@ lines, EdgeForm[{Black, Thick}], White,
Disk[#, .05] /@ pts}, ImageSize > 520]]
Eighteen points in 18 lines of 4 points is harder, since it seems to require 3 points at infinity. When lines are parallel, projective geometers say that the lines intersect at infinity. With 4 points on each line and each line through 4 points, this is a 4configuration.
Module[{config18, linesconfig18, inf},
config18 = {{0,
Root[9  141 #1^2 + #1^4 , 1]}, {1/4 (21  9 Sqrt[5]),
Root[9  564 #1^2 + 16 #1^4 , 4]}, {1/4 (21 + 9 Sqrt[5]),
Root[9  564 #1^2 + 16 #1^4 , 4]}, {0, 2 Sqrt[3]}, {3, Sqrt[
3]}, {3, Sqrt[3]}, {0, Sqrt[3]}, {3/
2, (Sqrt[3]/2)}, {(3/2), (Sqrt[3]/2)}, {1/4 (3 + 3 Sqrt[5]),
Root[9  564 #1^2 + 16 #1^4 , 4]}, {1/4 (9 + 3 Sqrt[5]),
Root[225  420 #1^2 + 16 #1^4 , 1]}, {1/2 (6  3 Sqrt[5]), (
Sqrt[3]/2)}, {0,
Root[144  564 #1^2 + #1^4 , 4]}, {1/2 (21 + 9 Sqrt[5]),
Root[9  141 #1^2 + #1^4 , 1]}, {1/2 (21  9 Sqrt[5]),
Root[9  141 #1^2 + #1^4 , 1]}};
linesconfig18 = SplitBy[SortBy[Union[Flatten[First[#], 1]] /@
(Transpose /@ Select[
SplitBy[
SortBy[{#, RootReduce[RowReduce[Append[#, 1] /@ #]]} /@
Subsets[config18, {2}], Last], Last], Length[#] > 1 ]),
Length], Length];
inf = Select[
SplitBy[SortBy[linesconfig18[[1]],
RootReduce[slope[Take[#, 2]]] ],
RootReduce[slope[Take[#, 2]]] ], Length[#] > 3 ];
Graphics[{Thick, Line /@ linesconfig18[[2]], Red,
InfiniteLine[Take[#, 2]] /@ inf[[1]], Green,
InfiniteLine[Take[#, 2]] /@ inf[[2]], Blue,
InfiniteLine[Take[#, 2]] /@ inf[[3]], EdgeForm[Black], White,
Disk[#, .7] /@ config18}, ImageSize > {520, 460}]]
If you do not like points at infinity, arrange 3 heptagons of 7 points to make a 4configuration of 21 lines through 21 points. That isn t the record, since it is possible to make at least 24 lines of 4 with 21 points.
Module[{pts, lines},
21 linepts =
4 {{0, b}, {0, (b c)/(
a  c)}, {2 a, b}, {0, ((b c)/(2 a + c))}, {0, (b c)/(
3 a  c)}, {a, b}, {a, b}, {c, 0}, {(c/3), 0}, {c/3,
0}, {c, 0}, {((3 a c)/(3 a  2 c)), (2 b c)/(3 a  2 c)}, {(
a c)/(3 a  2 c), (2 b c)/(3 a  2 c)}, {(3 a c)/(3 a  2 c), (
2 b c)/(3 a  2 c)}, {(a c)/(5 a  2 c), (2 b c)/(
5 a  2 c)}, {(a c)/(5 a + 2 c), (2 b c)/(5 a  2 c)}, {(
a c)/(3 a + 2 c), (2 b c)/(
3 a  2 c)}, {((a c)/(a + 2 c)), ((2 b c)/(a + 2 c))}, {(
a c)/(a + 2 c), ((2 b c)/(a + 2 c))}, {((a c)/(
3 a + 2 c)), ((2 b c)/(3 a + 2 c))}, {(a c)/(
3 a + 2 c), ((2 b c)/(3 a + 2 c))}} /. {a > 2, c > 1, b > 1};
lines = Union[Flatten[#, 1]] /@
Select[SplitBy[
SortBy[Subsets[pts, {2}], RowReduce[Append[#, 1] /@ #] ],
RowReduce[Append[#, 1] /@ #] ], Length[#] > 3 ];
Graphics[{Line /@ lines, EdgeForm[Black], White,
Disk[#, .3] /@ pts}, ImageSize > 500]]
The bestknown solution for 25 points has 32 lines, but this solution seems weak due to the low contribution made by the last 3 points. Progressively remove points labeled 25, 24, 23 (near the bottom) to see the bestknown solutions that produce 30, 28, 26 lines.
Module[{pts, lines},
pts = {{0, 1/4}, {0, 3/4}, {1, 1/2}, {1, 1/2}, {1, 1}, {1, 1}, {0,
0}, {0, 3/8}, {(1/3), 1/3}, {1/3, 1/3}, {(1/3), 1/6}, {1/3, 1/
6}, {(1/5), 2/5}, {1/5, 2/5}, {(1/5), 1/2}, {1/5, 1/
2}, {1, (1/2)}, {1, (1/2)}, {1, 1}, {1, 1}, {(1/3), 2/
3}, {1/3, 2/3}, {(1/3), (2/3)}, {1/3, (2/3)}, {9/5, (6/5)}};
lines = SplitBy[SortBy[
(Union[Flatten[#, 1]] /@ SplitBy[SortBy[Subsets[pts, {2}],
RowReduce[Append[#, 1] /@ #] ],
RowReduce[Append[#, 1] /@ #] ]), Length], Length];
Graphics[{InfiniteLine[Take[#, 2]] /@ lines[[3]],
White, EdgeForm[Black],
Table[{Disk[pts[[n]], .04], Black,
Style[Text[n, pts[[n]]], 8]}, {n, 1, Length[pts]}] /@ pts,
Black}, ImageSize > {520}]]
The 27 lines in space are, of course, the Clebsch surface. There are 12 points of intersection not shown, and some lines have 9 points of intersection.
Module[{lines27, clebschpoints},
lines27 =
Transpose /@ Flatten[Join[Table[RotateRight[#, n], {n, 0, 2}] /@
{{{(1/3), (1/3)}, {1, 1}, {1, 1}}, {{0,
0}, {1, (2/3)}, {(2/3), 1}}, {{1/3, 1/
3}, {1, (1/3)}, {(1/3), 1}}, {{0, 0}, {4/
9, (2/9)}, {1, 1}}, {{0, 0}, {1, 1}, {4/9, (2/9)}}},
Permutations[#] /@ {{{30, 30}, {35  19 Sqrt[5], 25 +
17 Sqrt[5]}, {5 + 3 Sqrt[5], 5  9 Sqrt[5]}}/
30, {{6, 6}, {3 + 2 Sqrt[5], 6  Sqrt[5]}, {7 + 4 Sqrt[5],
8  5 Sqrt[5]}}/6}], 1];
clebschpoints = Union[RootReduce[Flatten[With[
{sol =
Solve[e #[[1, 1]] + (1  e) #[[1, 2]] ==
f #[[2, 1]] + (1  f) #[[2, 2]]]},
If[Length[sol] > 0, (e #[[1, 1]] + (1  e) #[[1, 2]]) /. sol,
Sequence @@ {} ]] /@ Subsets[lines27, {2}], 1]]];
Graphics3D[{{
Sphere[#, .04] /@ Select[clebschpoints, Norm[#] < 1 ]},
Tube[#, .02] /@ lines27, Opacity[.4],
ContourPlot3D[
81 (x^3 + y^3 + z^3) 
189 (x^2 y + x^2 z + x y^2 + x z^2 + y^2 z + y z^2) +
54 x y z + 126 (x y + x z + y z)  9 (x^2 + y^2 + z^2) 
9 (x + y + z) + 1 == 0, {x, 1, 1}, {y, 1, 1}, {z, 1, 1},
Boxed > False][[1]]}, Boxed > False, SphericalRegion > True,
ImageSize > 520, ViewAngle > Pi/8]]
I m not sure that s optimal, since I managed to arrange 149 points in 241 lines of 5 points.
Module[{majorLines, tetrahedral, base, points, lines},
majorLines[pts_] := ((Drop[#1, 1] ) /@ #1 ) /@
Select[(Union[Flatten[#1, 1]] ) /@
SplitBy[SortBy[Subsets[(Append[#1, 1] ) /@ pts, {2}],
RowReduce], RowReduce], Length[#1] > 4 ];
tetrahedral[{a_, b_, c_}] :=
Union[{{a, b, c}, {a, b, c}, {b, c, a}, {b, c, a}, {c, a,
b}, {c, a, b}, {c, a, b}, {c, a, b}, {b, c, a}, {b, c,
a}, {a, b, c}, {a, b, c}}];
base = {{0, 0, 0}, {180, 180, 180}, {252, 252, 252}, {420, 420,
420}, {1260, 1260, 1260}, {0, 0, 420}, {0, 0, 1260}, {0, 180,
360}, {0, 315, 315}, {0, 360, 180}, {0, 420, 840}, {0, 630,
630}, {0, 840, 420}, {140, 140, 420}, {180, 180, 540}, {252, 252,
756}, {420, 420, 1260}};
points = Union[Flatten[tetrahedral[#] /@ base, 1]];
lines = majorLines[points];
Graphics3D[{Sphere[#, 50] /@ points,
Tube[Sort[#], 10] /@ Select[lines, Length[#] == 5 ]},
Boxed > False, ImageSize > {500, 460}]]
The 3D display is based on the following 2D solution, which has 25 points in 18 lines of 5 points. The numbers are barycentric coordinates. To use point 231, separate the digits (2,3,1), divide by the total (2/6,3/6,1/6) and simplify (1/3,1/2,1/6). If the outer triangle has area 1, the point 231 extended to the outer edges will make triangles of area (1/3,1/2,1/6).
Module[{peggpoints, elkpoints, elklines, linecoords},
peggpoints = Sort[#/Total[#] /@
Flatten[(Permutations /@ {{0, 0, 1}, {0, 1, 1}, {0, 1, 2}, {0, 4,
5}, {1, 1, 2}, {1, 2, 2},
{1, 2, 3}, {1, 2, 6}, {1, 4, 4}, {2, 2, 3}, {2, 2, 5}, {2, 3,
4}, {2, 3, 5}, {2, 5, 5}, {2, 6, 7}, {4, 5, 6}}), 1]];
elkpoints = Sort[#/Total[#] /@
Flatten[(Permutations /@ {{1, 1, 1}, {0, 0, 1}, {1, 2, 3}, {1, 1,
2}, {0, 1, 1}, {1, 2, 2}, {0, 1, 2}}), 1]];
elklines =
First /@ Select[
SortBy[Tally[BaryLiner[#] /@ Subsets[elkpoints, {2}]], Last],
Last[#] > 4 ];
linecoords =
Table[FromBarycentrics[{#[[1]], #[[2]]}, tri] /@
Select[elkpoints, elklines[[n]].# == 0 ], {n, 1, 18}];
Graphics[{AbsoluteThickness[3], Line /@ linecoords,
With[{coord = FromBarycentrics[{#[[1]], #[[2]]}, tri]}, {Black,
Disk[coord, .12], White, Disk[coord, .105], Black,
Style[Text[StringJoin[ToString /@ (# (Max[Denominator[#]]))],
coord], 14, Bold]}] /@ elkpoints},
ImageSize > {520, 450}]]
A further exploration of this is at Extreme Orchards for Gardner. There, I ask if a selfdual configuration exists where the point set is identical to the line set. I managed to find the following 24point 3configuration. The numbers represent {0,2,–1}, with blue = positive, red = negative and green = zero. In barycentric coordinates, a line {a,b,c} is on point {d,e,f} if the dot product {a,b,c}.{d,e,f}==0. For point {0,2,–1}, the lines {{–1,1,2},{–1,2,4},{0,1,2}} go through that point. Similarly, for line {0,2,–1}, the points {{–1,1,2},{–1,2,4},{0,1,2}} are on that line. The set of 24 points is identical to the set of 24 lines.
FromBarycentrics[{m_, n_,
o_}, {{x1_, y1_}, {x2_, y2_}, {x3_, y3_}}] := {m*x1 +
n*x2 + (1  m  n)*x3, m*y1 + n*y2 + (1  m  n)*y3};
tri = Reverse[{{Sqrt[3]/2, (1/2)}, {0,
1}, {(Sqrt[3]/2), (1/2)}}]; With[{full =
Union[Flatten[{#, RotateRight[#, 1], RotateLeft[#, 1]} /@
{{1, 0, 2}, {1, 1, 2}, {1, 2, 0}, {1, 2, 1}, {1, 2,
4}, {1, 4, 2}, {0, 1, 2}, {0, 2, 1}}, 1]]},
Graphics[{EdgeForm[Black], Tooltip[Line[#[[2]]], Style[Row[
Switch[Sign[#], 1, Style[ToString[Abs[#]], Red], 0,
Style[ToString[Abs[#]], Darker[Green]], 1,
Style[ToString[Abs[#]], Blue]] /@ #[[1]]], 16, Bold]] /@
Table[{full[[k]], Sort[FromBarycentrics[#/Total[#], tri] /@
Select[full, full[[k]].# == 0 ]]}, {k, 1, Length[full]}],
White, {Disk[FromBarycentrics[#/Total[#], tri], .15], Black,
Style[Text[
Row[Switch[Sign[#], 1, Style[ToString[Abs[#]], Red], 0,
Style[ToString[Abs[#]], Darker[Green]], 1,
Style[ToString[Abs[#]], Blue]] /@ #],
FromBarycentrics[#/Total[#], tri]], 14, Bold]} /@ full},
ImageSize > 520]]
With a longer computer run, I found an order27, selfdual 4configuration where the points and lines have the same set of barycentric coordinates.
With[{full =
Union[Flatten[{#, RotateRight[#, 1],
RotateLeft[#, 1]} /@ {{2, 1, 4}, {2, 1, 3}, {1, 1,
1}, {1, 2, 0}, {1, 2, 1}, {1, 3, 2}, {1, 4, 2}, {0, 1,
2}, {1, 1, 2}}, 1]]},
Graphics[{EdgeForm[Black], Tooltip[Line[#[[2]]], Style[Row[
Switch[Sign[#], 1, Style[ToString[Abs[#]], Red], 0,
Style[ToString[Abs[#]], Darker[Green]], 1,
Style[ToString[Abs[#]], Blue]] /@ #[[1]]], 16, Bold]] /@
Table[{full[[k]],
Sort[FromBarycentrics[#/Total[#], tri] /@
Select[full, full[[k]].# == 0 ]]}, {k, 1, Length[full]}],
White, {Tooltip[Disk[FromBarycentrics[#/Total[#], tri], .08],
Style[Row[
Switch[Sign[#], 1, Style[ToString[Abs[#]], Red], 0,
Style[ToString[Abs[#]], Darker[Green]], 1,
Style[ToString[Abs[#]], Blue]] /@ #], 16, Bold]]} /@
full}, ImageSize > 520]]
And now back to the mathematics of threeinarow, frequently known as elliptic curve theory, but I ll mostly be veering into geometry.
Cubic Curves and ZeroSum Geometries
In the cubic curve given by y = x3, all the triples from { 7, 6, ,7} that sum to zero happen to be on a straight line. The Table values are adjusted so that the aspect ratio will be reasonable.
simplecubic = Table[{x/7, x^3 /343}, {x, 7, 7}];
Graphics[{Cyan, Line[Sort[#]] /@ Select[Subsets[simplecubic, {3}],
Abs[Det[Append[#, 1] /@ #]] == 0 ], {Black, Disk[#, .07],
White, Disk[#, .06], Black, Style[Text[7 #[[1]], #], 16] } /@
simplecubic}, ImageSize > 520]
For example, (2,3, 5) has a zerosum. For the cubic curve, those numbers are at coordinates (2,8), (3,27) and ( 5, 125), which are on a line. The triple ( 2, 3, 2 + 3) also sums to zero and the corresponding points also lie on a straight line, but ignore that: restrict the coordinates to integers. With the curve y = x3, all of the integers can be plotted. Any triple of integers that sums to zero is on a straight line.
TraditionalForm[
Row[{Det[MatrixForm[{{2, 8, 1}, {3, 27, 1}, {5, 125, 1}}]], " = ",
Det[{{2, 8, 1}, {3, 27, 1}, {5, 125, 1}}]}]]
We can use the concept behind the cubic curve to make a rotationally symmetric zerosum geometry around 0. Let blue, red and green represent positive, negative and zero values. Start with:
To place the values 3 and 4, variables e and f are needed. The positions of all subsequent points up to infinity are forced.
Note that e and f should not be 0 or 1, since that would cause all subsequent points to overlap on the first five points.
Instead of building around 0, values can instead be reflected in the y = x diagonal to make a mirrorsymmetric zerosum geometry.
Skew symmetry is also possible with the addition of variables (m,n).
The six variables (a,b,c,d,e,f) completely determine as many points as you like with rotational symmetry about (0,0) or mirror symmetry about the line y = x. Adding the variables (m,n) allows for a skew symmetry where the lines and intersect at (0,0). In the Manipulate, move to change (a,b) and to change (c,d). Move horizontally to change e and vertically to change f. For skew symmetry, move to change the placements of and .
Manipulate[
Module[{ halfpoints, triples, initialpoints, pts2, candidate2},
halfpoints = Ceiling[(numberofpoints  1)/2];
triples =
Select[Subsets[Range[halfpoints, halfpoints], {3}],
Total[#] == 0 ];
initialpoints =
rotational /. Thread[{a, b, c, d, e, f} > Flatten[{ab, cd, ef}]];
If[symmetry == "mirror",
initialpoints =
mirror /. Thread[{a, b, c, d, e, f} > Flatten[{ab, cd, ef}]]];
If[symmetry == "skew",
initialpoints =
skew /. Thread[{a, b, c, d, e, f, m, n} >
Flatten[{ab, cd, ef, mn}]]];
pts2 = Join[initialpoints, Table[{{0, 0}, {0, 0}}, {46}]];
Do[pts2[[
index]] = (LineIntersectionPoint33[{{pts2[[1, #]],
pts2[[index  1, #]]}, {pts2[[2, #]],
pts2[[index  2, #]]}}] /@ {2, 1}),
{index, 5, 50}];
If[showcurve, candidate2 = NinePointCubic2[First /@ Take[pts2, 9]],
Sequence @@ {}];
Graphics[{
EdgeForm[Black],
If[showcurve,
ContourPlot[Evaluate[{candidate2 == 0}], {x, 3, 3}, {y, 3, 3},
PlotPoints > 15][[1]], Sequence @@ {}],
If[showlines, If[symmetry == "mirror",
{Black,
Line[pts2[[Abs[#], (3  Sign[#])/2 ]] /@ #] /@
Select[triples, Not[MemberQ[#, 0]] ],
Green,
InfiniteLine[
pts2[[Abs[#], (3  Sign[#])/
2 ]] /@ #] /@ (Drop[#, {2}] /@
Select[triples, MemberQ[#, 0] ])},
{Black,
Line[If[# == 0, {0, 0},
pts2[[Abs[#], (3  Sign[#])/2 ]]] /@ #] /@
triples}], Sequence @@ {}],
If[extrapoints > 0,
Table[{White, Disk[pts2[[n, index]], .03]}, {n, halfpoints + 1,
halfpoints + extrapoints}, {index, 1, 2}], Sequence @@ {}],
Table[{White, Disk[pts2[[n, index]], .08], {Blue, Red}[[index]],
Style[Text[n, pts2[[n, index]]] , 12]}, {n, halfpoints,
1, 1}, {index, 1, 2}],
If[symmetry != "mirror", {White, Disk[{0, 0}, .08], Green,
Style[Text[0, {0, 0}] , 12]}, Sequence @@ {}],
Inset[\!\(\*
GraphicsBox[
{RGBColor[1, 1, 0], EdgeForm[{GrayLevel[0], Thickness[Large]}],
DiskBox[{0, 0}],
{RGBColor[0, 0, 1],
StyleBox[InsetBox["\", {0.05, 0.05}],
StripOnInput>False,
FontSize>18,
FontWeight>Bold]}},
ImageSize>{24, 24}]\), ab], Inset[\!\(\*
GraphicsBox[
{RGBColor[1, 1, 0], EdgeForm[{GrayLevel[0], Thickness[Large]}],
DiskBox[{0, 0}],
{RGBColor[0, 0, 1],
StyleBox[InsetBox["\", {0.07, 0.05}],
StripOnInput>False,
FontSize>18,
FontWeight>Bold]}},
ImageSize>{24, 24}]\), cd], Inset[\!\(\*
GraphicsBox[
{RGBColor[0, 1, 0], EdgeForm[{GrayLevel[0], Thickness[Large]}],
DiskBox[{0, 0}],
{GrayLevel[0],
StyleBox[InsetBox["\", {0, 0}],
StripOnInput>False,
FontSize>9]}},
ImageSize>{21, 21}]\), ef], If[symmetry == "skew", Inset[\!\(\*
GraphicsBox[
{RGBColor[1, 0, 1], EdgeForm[{GrayLevel[0], Thickness[Large]}],
DiskBox[{0, 0}],
{GrayLevel[0],
StyleBox[InsetBox["\", {0, 0}],
StripOnInput>False,
FontSize>9]}},
ImageSize>{21, 21}]\), mn], Sequence @@ {}]},
ImageSize > {380, 480},
PlotRange >
Dynamic[(3/2)^zoom {{2.8, 2.8}  zx/5, {2.5, 2.5}  zy/5}]]],
{{ab, {2, 2}}, {2.4, 2.4}, {2.4, 2.4}, ControlType > Locator,
Appearance > None},
{{cd, {2, 2}}, {2.4, 2.4}, {2.4, 2.4}, ControlType > Locator,
Appearance > None},
{{ef, {.7, .13}}, {2.4, 2.4}, {2.4, 2.4}, ControlType > Locator,
Appearance > None},
{{mn, {2.00, 0.5}}, {2.4, 2.4}, {2.4, 2.4},
ControlType > Locator, Appearance > None},
"symmetry",
Row[{Control@{{symmetry, "rotational", ""}, {"rotational", "mirror",
"skew"}, ControlType > PopupMenu}}],
"",
"points shown",
{{numberofpoints, 15, ""}, 5, 30, 2, ControlType > PopupMenu},
"",
"extra points",
{{extrapoints, 0, ""}, 0, 20, 1, ControlType > PopupMenu},
"",
"move zero",
Row[{Control@{{zx, 0, ""}, 10, 10, 1, ControlType > PopupMenu},
" 5", Style["x", Italic]}],
Row[{Control@{{zy, 0, ""}, 10, 10, 1, ControlType > PopupMenu},
" 5", Style["y", Italic]}],
"",
"zoom exponent",
{{zoom, 0, ""}, 2, 3, 1, ControlType > PopupMenu},
"",
"show these",
Row[{Control@{{showlines, True, ""}, {True, False}}, "lines"}],
Row[{Control@{{showcurve, False, ""}, {True, False}}, "curve"}],
TrackedSymbols :> {ab, cd, ef, mn, zx, zy, symmetry,
numberofpoints, extrapoints, zoom},
ControlPlacement > Left,
Initialization :> (
Clear[a]; Clear[b]; Clear[c]; Clear[d]; Clear[e]; Clear[f];
Clear[m]; Clear[n];
NinePointCubic2[pts3_] :=
Module[{makeRow2, cubic2, poly2, coeff2, nonzero, candidate},
If[Min[
Total[Abs[RowReduce[#][[3]]]] /@
Subsets[Append[#, 1] /@ pts3, {4}]] > 0,
makeRow2[{x_, y_}] := {1, x, x^2, x^3, y, y x, y x^2, y^2,
y^2 x, y^3};
cubic2[x_, y_][p_] := Det[makeRow2 /@ Join[{{x, y}}, p]];
poly2 = cubic2[x, y][pts3];
coeff2 = Flatten[CoefficientList[poly2, {y, x}]];
nonzero = First[Select[coeff2, Abs[#] > 0 ]];
candidate = Expand[Simplify[ poly2/nonzero]];
If[Length[FactorList[candidate]] > 2, "degenerate", candidate],
"degenerate"]];
LineIntersectionPoint33[{{a_, b_}, {c_, d_}}] := (
Det[{a, b}] (c  d)  Det[{c, d}] (a  b))/Det[{a  b, c  d}];
skew = {{{a, b}, {a m, b m}}, {{c, d}, {c n,
d n}}, {{a e m  c (1 + e) n, b e m  d (1 + e) n}, {(
a e m + c n  c e n)/(e m + n  e n), (b e m + d n  d e n)/(
e m + n  e n)}}, {{a f m  ((1 + f) (a e m  c (1 + e) n))/(
e (m  n) + n),
b f m  ((1 + f) (b e m  d (1 + e) n))/(e (m  n) + n)}, {(
c (1 + e) (1 + f) n + a m (e + e f (1 + m  n) + f n))/(
1 + f (1 + e m (m  n) + m n)), (
d (1 + e) (1 + f) n + b m (e + e f (1 + m  n) + f n))/(
1 + f (1 + e m (m  n) + m n))}}};
rotational = {#, #} /@ {{a, b}, {c, d}, {c (1 + e)  a e,
d (1 + e)  b e}, {c (1 + e) (1 + f) + a (e  (1 + e) f),
d (1 + e) (1 + f) + b (e  (1 + e) f)}};
mirror = {#, Reverse[#]} /@ {{a, b}, {c, d}, {d (1  e) + b e,
c (1  e) + a e}, {(c (1  e) + a e) (1  f) +
b f, (d (1  e) + b e) (1  f) + a f}};),
SynchronousInitialization > False, SaveDefinitions > True]
In the rotationally symmetric construction, point 7 can be derived by finding the intersection of lines , and .
TraditionalForm[
FullSimplify[{h zerosumgeometrysymmetric[[2,
2]] + (1  h) zerosumgeometrysymmetric[[5, 2]] } /.
Solve[h zerosumgeometrysymmetric[[2,
2]] + (1  h) zerosumgeometrysymmetric[[5, 2]] ==
j zerosumgeometrysymmetric[[3,
2]] + (1  j) zerosumgeometrysymmetric[[4, 2]] , {h, j}][[
1]]][[1]]]
The simple cubic had 15 points 7 to 7 producing 25 lines. That falls short of the record 31 lines. Is there a way to get 6 more lines? Notice 6 triples with a sum of 0 modulus 15:
Select[Subsets[Range[7, 7], {3}], Abs[Total[#]] == 15 ]
We can build up the triangle area matrices for those sets of points. If the determinant is zero, the points are on a straight line.
matrices15 =
Append[zerosumgeometrysymmetric[[#, 1]], 1] /@ # /@ {{2, 6,
7}, {3, 5, 7}, {4, 5, 6}};
Row[TraditionalForm@Style[MatrixForm[#]] /@ (matrices15),
Spacer[20]]
Factor each determinant and hope to find a shared factor other than bc ad, which puts all points on the same line. It turns out the determinants have e + e2 + f – e f + f2 – e f2 + f3 as a shared factor.
Column[FactorList[Numerator[Det[#]]] /@ matrices15]
Are there any nice solutions for e + e2 + f – e f + f2 – e f2 + f3 = 0? Turns out letting e= (the golden ratio) allows f = 1.
Take[SortBy[Union[
Table[FindInstance[e + e^2 + f  e f + f^2  e f^2 + f^3 == 0
e > 0 f > ff, {e, f}, Reals], {ff, 2, 2, 1/15}]],
LeafCount], 6]
Here s what happens with base points (a,b) = (1,1), (c,d) = (1, 1) and that value of (e,f).
points15try =
RootReduce[zerotripsymm[{1, 1, 1, 1, (1 + Sqrt[5])/2, 1}, 7]];
zerosumGraphic[points15try/5, 15, 1.5 {260, 210}]
The solution s convex hull is determined by points 4 and 2, so those points can be moved to make the solution more elegant.
RootReduce[({{w, x}, {y, z}} /.
Solve[{{{w, x}, {y, z}}.points15try[[2, 1]] == {1, 1},
{{w, x}, {y, z}}.points15try[[4, 1]] == {1, 1}}][[
1]]).# /@ {points15try[[1, 1]],
points15try[[2, 1]]}]
The values for (a,b,c,d) do not need to be exact, so we can find the nearest rational values.
nearestRational[#, 20] /@
Flatten[{{9  4 Sqrt[5], 5  2 Sqrt[5]}, {1, 1}}]
That leads to an elegantlooking solution for the 15tree problem. There are 31 lines of 3 points, each a triple that sums to 0 (mod 15).
points15 =
RootReduce[zerotripsymm[{1/18, 9/17, 1, 1, (1 + Sqrt[5])/2, 1}, 7]];
zerosumGraphic[points15, 15, 1.5 {260, 210}]
The 14point version leads to polynomial equation 2e – 2e2 – f + e f + e – e f2 = 0, which has the nice solution {e>1/2,f> ( 1+ 17)/4}. A point at infinity is needed for an even number of points with this method.
{{{1, 1}, {1, 1}}, {{1, 1}, {1, 1}}, {{1, 0}, {1,
0}}, {{1/2 (3  Sqrt[17]),
1/4 (1  Sqrt[17])}, {1/2 (3 + Sqrt[17]),
1/4 (1 + Sqrt[17])}}, {{1/4 (5  Sqrt[17]),
1/8 (1 + Sqrt[17])}, {1/4 (5 + Sqrt[17]),
1/8 (1  Sqrt[17])}}, {{1/8 (3 + 3 Sqrt[17]),
1/16 (7 + Sqrt[17])}, {1/8 (3  3 Sqrt[17]),
1/16 (7  Sqrt[17])}}}
The solution on 15 points can be tweaked to give a match for the 16point, 37line solution in various ways. The is not particularly meaningful here. The last example is done with skew symmetry, even though it seems the same.
Grid[Partition[{zerosumGraphic[
zerotripsymm[{5  2 Sqrt[5], 9  4 Sqrt[5], 1, 1,
1/2 (1 + Sqrt[5]), 1}, 7], 15, {260, 210}],
zerosumGraphic[
zerotripsymm[{5  2 Sqrt[5], 9  4 Sqrt[5], 1, 1,
1/2 (1 + Sqrt[5]), 1}, 7], 16, {260, 210}],
zerosumGraphic[
zerotripsymm[{1, 1, 1, 1, 3  Sqrt[5], 1/2 (3  Sqrt[5])}, 7],
16, {260, 210}],
zerosumGraphic[
RootReduce[
zerotripskew[{0,
1  Sqrt[5], 3 + Sqrt[5], 3 + Sqrt[5], 1 + Sqrt[5],
1/2 (1 + Sqrt[5]), 1/2 (1 + Sqrt[5]), 1/2 (1 + Sqrt[5])},
7]], 16, {260, 210}]}, 2]]
The first solution is a special case of the 15solution with an abnormal amount of parallelism, enough to match the sporadic 16point solution. How did I find it?
OrchardPlanting Polynomials
Here are coordinates for the positive points up to 4 in the mirrorsymmetric and skewsymmetric cases. They quickly get more complicated.
TraditionalForm@
Grid[Prepend[
Transpose[
Prepend[Transpose[First /@ Take[zerosumgeometrymirror, 4]],
Range[1, 4]]], {"number", x, y}],
Dividers > {{2 > Green}, {2 > Green}}]
TraditionalForm@
Grid[Prepend[
Transpose[
Prepend[Transpose[
Prepend[First /@ Take[zerosumgeometryskew, 4], {0, 0}]],
Range[0, 4]]], {"number", x, y}],
Dividers > {{2 > Blue}, {2 > Blue}}]
Here are coordinates for the positive points up to 7 in the rotationally symmetric case. These are more tractable, so I focused on them.
TraditionalForm@
Grid[Prepend[
Transpose[
Prepend[Transpose[
Prepend[First /@ Take[zerosumgeometrysymmetric, 7], {0, 0}]],
Range[0, 7]]], {"number", x, y}],
Dividers > {{2 > Red}, {2 > Red}}]
For 14 and 15 points, the polynomials 2e – 2e2 – f + e f + e2 f – e f2 and e + e2 + f – e f + f2 – e f2 + f3 appeared almost magically to solve the problem. Why did that happen? I have no idea, but it always seems to work. I ll call these orchardplanting polynomials. It s possible that they ve never been used before to produce elegant solutions for this problem, because we would have seen them. Here are the next few orchardplanting polynomials. As a reminder, these are shared factors of the determinants generated by forcing triples modulo p to be lines.
Monitor[TraditionalForm@Grid[Prepend[Table[
With[{subs =
Select[Subsets[Range[Floor[n/2], Floor[n/2]], {3}],
Mod[ Abs[Total[#]], n ] == 0
Not[MemberQ[#, (n/2)]] ]}, {n, Length[subs],
Select[subs, Min[#] > 0 Max[#] < 13 Max[#] < n/2 ],
Last[SortBy[
Apply[Intersection, (First[Sort[FullSimplify[{#, #}]]] /@
First /@ FactorList[Numerator[#]] /@
Expand[Det[
Append[zerosumgeometrysymmetric[[#, 1]],
1] /@ #] /@
Select[subs,
Min[#] > 0 Max[#] < 13 Max[#] < n/2 ]])],
LeafCount]]}], {n, 11, 16}], {"trees", "lines",
"triples needing modulus", "orchard planting polynomial"}]], n]
Here is the major step for the solution of 14 trees. The item showing up in the numerator generated by (3,5,6) happens to be the denominator of item 7 = (3 + 5 + 6)/2.
With[{mat =
Append[zerosumgeometrysymmetric[[#, 1]], 1] /@ {3, 5, 6}},
TraditionalForm[
Row[{Det[MatrixForm[mat]], " = ", Factor[Det[mat]] == 0,
"\n compare to ",
Expand[Denominator[zerosumgeometrysymmetric[[7, 1, 1]] ]]}]]]
But I should have expected this. The solution for 18 points is next. The point 9 is at infinity! Therefore, level 9 needs 1/0 to work properly.
zerosumGraphic[zerotripsymm[orchardsolutions[[18, 4]], 8], 18,
2 {260, 210}]
Here's a contour plot of all the orchardplanting polynomials up to order 28. The number values give the location of a particularly elegant solution for that number of points.
allorchardpolynomials =
Table[orchardsolutions[[ff, 5]] == 0, {ff, 11, 27,
2}]; Graphics[{ContourPlot[
Evaluate[allorchardpolynomials], {e, 3/2, 2}, {f, 3/2, 2},
PlotPoints > 100][[1]], Red,
Table[Style[Text[n, Take[orchardsolutions[[n, 4]], 2]], 20], {n,
11, 28}]}]
Recall from the construction that e and f should not be 0 or 1, since that would cause all subsequent points to overlap on the first five points, causing degeneracy. The curves intersect at these values.
We can also plot the locations where the e f values lead to lines of two points having the same slope. Forcing parallelism leads to hundreds of extra curves. Do you see the lowerright corner where the green curve is passing through many black curves? That's the location of the sporadic 16point solution. It's right there!
slope[{{x1_, y1_}, {x2_, y2_}}] := (y2  y1)/(x2  x1);
theslopes = {#  1,
FullSimplify[
slope[Prepend[
First /@ Take[zerosumgeometrysymmetric, 11], {0,
0}][[#]]]]} /@
Subsets[Range[
10], {2}]; sameslope = {#[[2, 1]], #[[1]]} /@ (Transpose /@
SplitBy[SortBy[{#[[1]], #[[2, 1]] ==
Simplify[#[[2, 2]]]} /@ ({#[[1]], Flatten[#[[2]]]} /@
SortBy[
Flatten[Transpose[{Table[#[[
1]], {Length[#[[2]]]}], (List @@@ # /@ #[[
2]])}] /@
Select[{#[[1]],
Solve[{#[[2, 1]] == #[[2, 2]], d != (b c)/a , e != 0,
e != 1, f != 0, f != 1}]} /@
Take[SortBy[(Transpose /@
Select[Subsets[theslopes, {2}],
Length[Union[Flatten[First /@ #]]] == 4 ]),
Total[Flatten[#[[1]]]] ], 150],
Length[StringPosition[ToString[FullForm[#[[2]]]],
"Complex"]] == 0 Length[#[[2]]] > 0 ], 1],
Last]), Last], Last]);
Graphics[{Table[
ContourPlot[
Evaluate[sameslope[[n, 1]]], {e, 3/2, 2}, {f, 3/2, 2},
PlotPoints > 50, ContourStyle > Black][[1]], {n, 1, 162}], Red,
Table[ContourPlot[
Evaluate[allorchardpolynomials[[n]]], {e, 3/2, 2}, {f, 3/2,
2}, PlotPoints > 50, ContourStyle > Green][[1]], {n, 1, 18}],
Tooltip[Point[#], #] /@ Tuples[Range[6, 6]/4, {2}] }]
That's my way to find sporadic solutions. The mirror and skew plots have added levels of messiness sufficient to defy my current ability to analyze them.
Is there an easy way to generate these polynomials? I have no idea. Here are plots of their coefficient arrays.
Column[{Text@
Grid[{Range[11, 22],
With[{array = CoefficientList[#, {e, f}]},
With[{rule = Thread[Apply[Range, MinMax[Flatten[array]]] >
Join[Reverse[
Table[ RGBColor[1, 1  z/Abs[Min[Flatten[array]]],
1  z/Abs[Min[Flatten[array]]]], {z, 1,
Abs[Min[Flatten[array]]]}]],
{RGBColor[1, 1, 1]},
Table[ RGBColor[1  z/Abs[Max[Flatten[array]]], 1,
1], {z, 1, Abs[Max[Flatten[array]]]}]]]},
ArrayPlot[array, ColorRules > rule,
ImageSize > Reverse[Dimensions[array]] {7, 7},
Frame > False ]]] /@ (#[[5]] /@
Take[orchardsolutions, {11, 22}])}, Frame > All],
Text@Grid[{Range[23, 28],
With[{array = CoefficientList[#, {e, f}]},
With[{rule = Thread[Apply[Range, MinMax[Flatten[array]]] >
Join[Reverse[
Table[ RGBColor[1, 1  z/Abs[Min[Flatten[array]]],
1  z/Abs[Min[Flatten[array]]]], {z, 1,
Abs[Min[Flatten[array]]]}]],
{RGBColor[1, 1, 1]},
Table[ RGBColor[1  z/Abs[Max[Flatten[array]]], 1,
1], {z, 1, Abs[Max[Flatten[array]]]}]]]},
ArrayPlot[array, ColorRules > rule,
ImageSize > Reverse[Dimensions[array]] {7, 7},
Frame > False ]]] /@ (#[[5]] /@
Take[orchardsolutions, {23, 28}])}, Frame > All]},
Alignment > Center]
Graphics of Orchard Solutions
Grid[Partition[Table[Quiet@
zerosumGraphic[
If[orchardsolutions[[n, 2]] > orchardsolutions[[n, 3]],
orchardsolutions[[n, 6]],
Quiet@zerotripsymm[orchardsolutions[[n, 4]],
Floor[(n  1)/2]]], n, {260, 210}], {n, 9, 28}], 2]]
Download the full notebook to see all the code used for finding elegantlooking solutions.
Unsolved Problems
Looking for unsolved problems of the orchardplanting variety? Here are several I suggest:
Do more sporadic solutions exist for the threeorchard problem?
Can 11 and 19point solutions be found with partial zerosum geometry?
Do better solutions exist for fourorchard solutions on 17 or more points?
Do smaller 3 and 4configurations exist where the sets of the barycentric coordinates for the points and lines are the same?
Does a 5configuration exist where the sets of the barycentric coordinates for the points and lines are the same?
What are best solutions for the fiveorchard problem?
Is there a good method for generating orchardplanting polynomials?
And if you'd like to explore more recreational mathematics, check out some of the many entries on the Wolfram Demonstrations Project.  ↑ 
4. The Wolfram Language Bridges Mathematics and the ArtsПт., 26 янв.[−] Every summer, 200some artists, mathematicians and technologists gather at the Bridges conference to celebrate connections between mathematics and the arts. It s five exuberant days of sharing, exploring, puzzling, building, playing and discussing diverse artistic domains, from poetry to sculpture.
The Wolfram Language is essential to many Bridges attendees work. It s used to explore ideas, puzzle out technical details, design prototypes and produce output that controls production machines. It s applied to sculpture, graphics, origami, painting, weaving, quilting—even baking.
In the many years I ve attended the Bridges conferences, I ve enjoyed hearing about these diverse applications of the Wolfram Language in the arts. Here is a selection of Bridges artists work.
George Hart
George Hart is well known for his insanely tangled sculptures based on polyhedral symmetries. Two of his recent works, SNOBall and Clouds, were puzzled out with the help of the Wolfram Language:
This video includes a Wolfram Language animation that shows how the elements of the Clouds sculpture were transformed to yield the vertically compressed structure.
One of Hart s earliest Wolfram Language designs was for the Millennium Bookball, a 1998 commission for the Northport Public Library. Sixty wooden books are arranged in icosahedral symmetry, joined by cast bronze rings. Here is the Wolfram Language design for the bookball and a photo of the finished sculpture:
One of my favorite Hart projects was the basis of a paper with Robert Hanson at the 2013 Bridges conference: Custom 3DPrinted Rollers for Frieze Pattern Cookies. With a paragraph of Wolfram Language code, George translates images to 3Dprinted rollers that emboss the images on, for example, cookie dough:
It s a brilliant application of the Wolfram Language. I ve used it myself to make cookieroller presents and rollers for patterning ceramics. You can download a notebook of Hart s code. Since Hart wrote this code, we ve added support for 3D printing to the Wolfram Language. You can now send roller designs directly to a printing service or a local 3D printer using Printout3D.
Christopher Hanusa
Christopher Hanusa has made a business of selling 3Dprinted objects created exclusively with the Wolfram Language. His designs take inspiration from mathematical concepts—unsurprising given his position as an associate professor of mathematics at Queens College, City University of New York.
Hanusa s designs include earrings constructed with mesh and region operations:
a pendant designed with transformed graphics primitives:
ornaments designed with ParametricPlot3D:
and a tea light made with ParametricPlot3D, using the RegionFunction option to punch an interesting pattern of perforations into the cylinder:
Hanusa has written about how he creates his designs with the Wolfram Language on his blog, The Mathematical Zorro. You can see all of Hanusa s creations in his Shapeways shop.
William F. Duffy
William F. Duffy, an accomplished traditional sculptor, also explores forms derived from parametric equations and cast from largescale resin 3D prints. Many of his forms result from Wolfram Language explorations.
Here, for example, are some of Duffy s explorations of a fifthdegree polynomial that describes a Calabi–Yau space, important in string theory:
Duffy plotted one instance of that function in Mathematica, 3Dprinted it in resin and made a mold from the print in which the bronze sculpture was cast. On the left is a gypsum cement test cast, and on the right the finished bronze sculpture, patinated with potassium sulfide:
On commission from the Simons Center for Geometry and Physics, Duffy created the object on the left as a bronzeinfused, stainless steel 3D print. The object on the right was created from the same source file, but printed in nylon:
Duffy continues to explore functions on the complex plane as sources for sculptural structures:
You will be able to see more of Duffy s work, both traditional and mathematical, on his forthcoming website.
Robert Fathauer
Robert Fathauer uses the Wolfram Language to explore diverse phenomena, including fractal structures with negative curvature that are reminiscent of natural forms. This print of such a form was exhibited in the Bridges 2013 art gallery:
Fathauer realizes the ideas he explores in meticulously handcrafted ceramic forms reminiscent of corals and sponges:
One of Fathauer s Mathematicadesigned ceramic works consisted of 511 cubic elements (!). Here are shots of the Wolfram Language model and its realization, before firing, as a ceramic sculpture:
Unfortunately, in what Fathauer has confirmed was a painful experience, the sculpture exploded in the kiln during firing. But this structure, as well as several other fractal structures designed with the Wolfram Language, is available in Fathauer s Shapeways shop.
Martin Levin
Martin Levin makes consummately crafted models that reveal the structure of our world—the distance, angular and topological relationships that govern the possibilities and impossibilities of 3D space:
What you don t—or barely—see is where the Wolfram Language has had the biggest impact in his work. The tiny connectors that join the tubular parts are 3D printed from models designed with the Wolfram Language:
Levin is currently designing 3Dprinted modules that can be assembled to make a lostplastic bronze casting of a compound of five tetrahedra:
The finished casting should look something like this (but mirrorreversed):
Henry Segerman
Henry Segerman explored some of the topics in his engaging book Visualizing Mathematics with 3D Printing with Wolfram Language code. While the forms in the book are explicitly mathematical, many have an undeniable aesthetic appeal. Here are snapshots from his initial explorations of surfaces with interesting topologies
which led to these 3Dprinted forms in his Shapeways shop:
His beautiful Archimedean Spire
was similarly modeled first with Wolfram Language code:
In addition to mathematical models, Segerman collaborates with Robert Fathauer (above) to produce exotic dice, whose geometry begins as Wolfram Language code—much of it originating from the Wolfram MathWorld entry Isohedron :
Elisabetta Matsumoto
In addition to constructing immersive virtual reality hyperbolic spaces, Elisabetta Matsumoto turns highpower mathematics into elegant jewelry using the Wolfram Language. This piece, which requires a full screen of mathematical code to describe, riffs on one of the earliest discovered minimal surfaces, Scherk s second surface:
Continuing the theme of hyperbolic spaces, here s one of Matsumoto s Wolfram Language designs, this one in 2D rather than 3D:
You can see Matsumoto s jewelry designs in her Shapeways shop.
Koos and Tom Verhoeff
Father and son Koos and Tom Verhoeff have long used the Wolfram Language to explore sculptural forms and understand the intricacies of miter joint geometries and torsion constraints that enable Koos to realize his sculptures. Their work is varied, from tangles to trees to lattices in wood, sheet metal and cast bronze. Here is a representative sample of their work together with the underlying Wolfram Language models, all topics of Bridges conference papers:
Three Families of Mitered Borromean Ring Sculptures
 ↑ 
5. Running the Numbers with the Illinois Marathon ViewerЧт., 18 янв.[−] I love to run. A lot. And many of my coworkers do too. You can find us everywhere, and all the time: on roads, in parks, on hills and mountains, and even running up and down parking decks, a flat lander s version of hills. And if there is a marathon to be run, we ll be there as well. With all of the internal interest in running marathons, Wolfram Research created this Marathon Viewer as a sponsorship project for the Christie Clinic Illinois Marathon.
Here are four of us, shown as dots, participating in the 2017 Illinois Marathon:
How did the above animation and the indepth look at our performance come about? Read on to find out.
Background
Why do I run? Of course, the expected answer is health. But when I go out for a run, I am really not concerned about my longevity. And quite frankly, given the number of times I have almost been hit by a car, running doesn t seem to be in my best interest. For me, it is simply a good way to maintain some level of sanity. Also, it is locationindependent. When I travel, I pack an extra pair of running shoes, and I am set. Running is a great way to scope out a new location. Additionally, runners are a very friendly bunch of people. We greet, we chat, we hate on the weather together. And lastly, have you ever been to a race? If so, then you know that the spectator race signs are hilarious, often politically incorrect and Rrated.
I started running longer distances in 2014. Since then, I have completed eight marathons, one of which was the 2015 Bank of America Chicago Marathon. After completing that race, I wrote a blog post analyzing the runner dataset and looking at various aspects of the race.
Since then, we have shifted focus to the Illinois Marathon here in Champaign. While Wolfram Research is an international company, it also makes sense for us to engage in our local community.
The Course
The Illinois Marathon does a great job tying together our twin cities of Champaign and Urbana. Just have a look at the map: starting in close proximity to the State Farm Center, the runners navigate across the UIUC campus, through both downtown areas, various residential neighborhoods and major parks for a spectacular finish on Zuppke Field inside Memorial Stadium.
Since its inception in 2009, the event has doubled the number of runners and races offered, as well as sponsors and partners involved. By attracting a large number of people traveling to Champaign and Urbana for this event, it has quite an economic impact on our community. This is also expressed in the amount of charitable givings raised every year.
The Marathon Viewer
As you can imagine, here at Wolfram we were very interested in doing a partnership with the marathon involving some kind of data crunching. Over the summer of 2017, we received the full registration dataset to work with. We applied the 10step process described by Stephen Wolfram in this blog post.
Original Dataset
We first import a simple spreadsheet.
raw = Import[
"/Users/eilas/Desktop/Work/Marathon/ILMarathon2017/Marathon_\
Results_Modified.csv", "Numeric" > False];
The raw table descriptions look as follows:
header = raw[[1]]
But it s more convenient to represent the raw data as key>value pairs:
fullmarathon = AssociationThread[header > #] /@ Rest[raw];
fullmarathon[[1]]
Interpreting Runner Entries
Wherever possible, these data points should be aligned with entities in the Wolfram Language. This not only allows for a consistent representation, but also gives access to all of the data in the Wolfram Knowledgebase for those items if desired later.
Interpreter is a very powerful tool for such purposes. It allows you to parse any arbitrary string as a particular entity type, and is often the first step in trying to align data. As an example, let s align the given location information.
allLocations2017 =
Union[{"CITY", "STATE", "COUNTRY"} /. fullmarathon];
Here is a random example.
locationExample = RandomChoice[allLocations2017]
Interpreter["City"][StringJoin[StringRiffle[locationExample]]]
In most cases, this works without a hitch. But some location information may not be what the system expects. Participants may have specified suburbs, neighborhoods, unincorporated areas or simply made a typo. This can make an automatic interpretation impossible. Thus, we need to be prepared for other contingencies. From the same dataset, let s look at this case:
problemExample = {"O Fallon", "IL", "United States"};
Interpreter["City"][StringJoin[StringRiffle[problemExample]]]
We can fall back to a contingency in such a case by making use of the provided postal code 62269.
With[{loc = Interpreter["Location"]["62269"]},
GeoNearest["City", loc]][[1]]
As you can see, we do know of the city, but the initial interpretation failed due to a missing apostrophe. In comparison, this would have worked just fine:
Interpreter["City"][
StringJoin[StringRiffle[{"O'Fallon", "IL", "United States"}]]]
The major piece of information that runners are interested in is their split times. The Illinois Marathon records the clock and net times at six split distances: start, 10 kilometers, 10 miles, 13.1 miles (halfmarathon distance), 20 miles and 26.2 miles (full marathon distance).
random20MTime = RandomChoice["20 MILE NET TIME" /. fullmarathon]
These are given as a list of three colonseparated numbers, which we want to represent as Wolfram Language Quantity objects.
Quantity[MixedMagnitude[
FromDigits /@ StringSplit[random20MTime, ":"]],
MixedUnit[{"Hours", "Minutes", "Seconds"}]]
As with the Interpreter mentioned before, we also have to be careful in interpreting the recorded times. For the halfmarathon split and longer distances, even the fastest runner needs at least an hour. Thus, we know xx: yy: zz always refers to hours: minutes: seconds . But for the shorter distances 10 kilometers and 10 miles, this might be minutes: seconds: milliseconds .
random10KTime = RandomChoice["10K NET TIME" /. fullmarathon]
This is then incorrect.
Quantity[MixedMagnitude[
FromDigits /@ StringSplit[random10KTime, ":"]],
MixedUnit[{"Hours", "Minutes", "Seconds"}]]
No runner took more than two days to finish a 10kilometer distance. Logic must be put in to verify the values before returning the final Quantity objects. This is the correct interpretation:
Quantity[MixedMagnitude[
FromDigits /@ StringSplit[random10KTime, ":"]],
MixedUnit[{"Minutes", "Seconds", "Milliseconds"}]]
Once the data has been cleaned up, it s just a matter of creating an Association of key>value pairs. An example piece of data for one runner shows the structure:
Interpreting Divisions
We did not just arrange the dataset by runner, but by division as well. The divisions recognized by most marathons are as follows:
{"Female19AndUnder", "Female20To24", "Female25To29", "Female30To34", \
"Female35To39", "Female40To44", "Female45To49", "Female50To54", \
"Female55To59", "Female60To64", "Female65To69", "Female70To74", \
"Male19AndUnder", "Male20To24", "Male25To29", "Male30To34", \
"Male35To39", "Male40To44", "Male45To49", "Male50To54", "Male55To59", \
"Male60To64", "Male65To69", "Male70To74", "Male75To79", \
"Male80AndOver", "FemaleOverall", "FemaleMaster", "MaleOverall", \
"MaleMaster"}
For each of these divisions, we included information about the minimum, maximum and mean running times. Since this marathon is held on a flat course and is thus fastpaced, we also added each division s Boston Marathon qualifying standard, and information about the runners qualifications.
With the data cleaned up and processed, it s now simple to construct an EntityStore so that the data can be used in the EntityValue framework in the Wolfram Language. It s mainly just a matter of attaching metadata to the properties so that they have displayfriendly labels.
EntityStore[
{"ChristieClinicMarathon2017" > "Christie Clinic Marathon 2017 participant",
"LabelPlural" > "Christie Clinic Marathon 2017 participants",
"Entities" > processed,
"Properties" > "bib number">,
"Event" > "event">,
"LastName" > "last name">,
"FirstName" > "first name">,
"Name" > "name">,
"Label" > "label">,
"City" > "city">,
"State" > "state">,
"Country" > "country">,
"ZIP" > "ZIP">,
"ChristieClinic2017Division" >
"Christie Clinic 2017 division">,
"Gender" > "gender">,
"PlaceDivision" > "place division">,
"PlaceGender" > "place gender">,
"PlaceOverall" > "place overall">,
"Splits" > "splits">>
>,
"ChristieClinic2017Division" > "Christie Clinic 2017 division",
"LabelPlural" > "Christie Clinic 2017 divisions",
"Entities" > divTypeEntities,
"Properties" > "label">,
"Mean" > "mean net time">,
"Min" > "min net time">,
"Max" > "max net time">,
"BQStandard" > "Boston qualifying standard">,
"BeatBQ" > "beat Boston qualifying standard">,
"NumberBeat" >
"count beat Boston qualifying standard">,
"RangeBQ" >
"within range Boston qualifying standard">,
"NumberRange" >
"count within range Boston qualifying standard">,
"OutsideBQ" >
"outside range Boston qualifying standard">,
"NumberOutside" >
"count outside range Boston qualifying standard">>
>}]
Star in Your Own Movie
In addition to creating the entity store, the split times also give us an estimate of a runner s position along the course as the race progresses. Thus we know the distribution of all runners throughout the race course. We took this information and plotted the runner density for each minute of an eighthour race, and combined the frames into a movie.
It would be interesting to see how a single runner compares to the entire field. Obviously we don t want to make a movie for 1,000+ runners and 500,000 movies for all possible pairs of runners. Instead, we utilized the fact that each runner follows a twodimensional path in the viewing plane perpendicular to the line going from the viewpoint to the center of the map. We calculated these 2D runner paths and superimposed them over the original movie frames. Since before exporting the frames are all Graphics3D expressions in the Wolfram Language, this worked like a charm. We created the one movie to run them all.
Now we need make the data available to the general public in an easily accessible way. An obvious choice is the use of the Wolfram Cloud. The entity store, the runner position data and the density movie are easily stored in our cloud. And with some magic from my terrific coworkers, we were able to combine it all into this amazing microsite.
By default, the movie is shown. Upon a user submitting a specific bib number, the movie is overlaid with individual runner information. Additionally, we are accessing all information stored about this specific runner and their division.
More information about the development of Wolfram microsites can be found here.
Ask WolframAlpha
Besides the microsite, there are many interesting computations that can be performed that surround the concept of a marathon. I have explored a few of these below.
To give you an idea of the size of the event, let s look at a few random numbers associated with the marathon weekend. Luckily, WolframAlpha has something to say about all of these.
One thousand two hundred seventeen runners finished the full marathon in 2017. This equals a total of 31,885.4 miles, which is comparable to 2.4 times the length of the Great Wall of China, or the length of 490,000 soccer fields.
WolframAlpha["31885.4 miles", {{"ComparisonAsLength", 1}, "Content"}]
WolframAlpha["how many soccer fields stretch 31885.4 miles", \
{{"ApproximateResult", 1}, "Content"}]
The marathon would literally not have ever happened had it not been for Walter Hunter inventing the safety pin back in 1849. About 80,000 of them were used during the weekend to keep bib numbers in place.
WolframAlpha["safety pin", {{"BasicInformation:InventionData", 1},
"Content"}]
The runners ate 1,600 oranges and 15,000 bananas, and drank 9,600 gallons of water and 1,920 gallons of Gatorade along the race course. WolframAlpha will tell you that 1,600 oranges are enough to fill two bathtubs:
WolframAlpha["How many oranges fit in a bathtub?", \
{{"ApproximateResult", 1}, "Content"}]
and contain an astounding 20 kilograms of sugar:
WolframAlpha["sugar in 1,600 oranges", {{"Result", 1}, "Content"}]
And trust me: 20 miles into the race while questioning all your life choices, a sweet orange slice will fix any problem. But let s get to the finish line: here the runners finished another 800 pounds of pasta, 1,100 pizzas and another 32,600 bottles of water. The pasta and pizza provided a combined 1.8 106 dietary calories:
WolframAlpha["calories in 800 lbs of pasta and 1100 pizzas", \
{{"Result", 1}, "Content"}]
But we are not done yet. The theme of the 2017 Illinois Marathon was the 150th birthday of the University of Illinois. Ever tried to pronounce sesquicentennial ? Going above and beyond, the race administration decided to provide the runners with 70 birthday sheet cakes each 18 24 inches. Thanks to the folks working at the Meijer bakery, we came to find out that each such cake contains 21,340 calories, totaling close to 1.5 million calories!
Table[WolframAlpha[
"70*21340 food calories", {{"Comparison", j}, "Content"}], {j,
2}] // Column
Remember the 15,000 bananas I mentioned just a few moments ago? Turns out that their calorie count is comparable to that of the sheet cakes. That might make for a difficult discussion with a child whether to sheet cake or to banana.
WolframAlpha["calories in 15,000 bananas", {{"Result", 1}, "Content"}]
What can one do with all those calories? You did just participate in a race, and should be able to splurge a bit on food. Consider a male person weighing 159 pounds running a marathon distance at a nineminutespermile pace. He burns roughly 3,300 calories.
WolframAlpha["Calories burned running at pace 9 min/mi for 26.2 \
miles", IncludePods > "MetabolicProperties",
AppearanceElements > {"Pods"}]
Though not recommended, you could have 32 guiltfree beers that are typically offered after a marathon race, or 17 servings of 2 2inch pieces of sheet cake.
CALORIES PER BEER
N[\!\(\*
NamespaceBox["LinguisticAssistant",
DynamicModuleBox[{Typeset`query$$ =
"3339 food calories/(21340 food calories/108)", Typeset`boxes$$ =
RowBox[{
TemplateBox[{
"3339", "\"Cal\"", "dietary Calories", "\"LargeCalories\""},
"Quantity", SyntaxForm > Mod], "/",
RowBox[{"(",
RowBox[{
TemplateBox[{
"21340", "\"Cal\"", "dietary Calories",
"\"LargeCalories\""}, "Quantity", SyntaxForm > Mod],
"/", "108"}], ")"}]}], Typeset`allassumptions$$ = {},
Typeset`assumptions$$ = {}, Typeset`open$$ = {1, 2},
Typeset`querystate$$ = {
"Online" > True, "Allowed" > True,
"mparse.jsp" > 0.709614`6.302567168615541, "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>{221., {10., 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]\)]
Did I mention weather? Weather in Champaign is an unwelcome participant: one who does not pay a race fee, is constantly in everyone s way, makes up its mind lastminute, does what it wants and unleashes full force. Though 2017 turned out fine, let s look at WeatherData for the 2016 and 2015 race weekends.
Last year, the rain set in with the start of the race, lasted through the entire event and left town when the race was over. I was drenched before even crossing the starting line.
Table[WolframAlpha[
"Weather Champaign 4/30/2016", {{"WeatherCharts:WeatherData", k},
"Content"}], {k, 2, 3}] // ColumnY
But that wasn t the worst we had seen: in 2015, a thunderstorm descended on this town while the race was ongoing. Thus, the Illinois Marathon is one of the few marathons that actually had to get canceled midrace.
As I mentioned at the very beginning, the runners here at Wolfram Research are a tough crowd, and weather won t deter us. If you feel inspired and would like to see yourself in a future version of the Marathon Viewer, this is the place to start: Illinois Marathon registration.
If you d like to work with the code you read here today, you can download this post as a Wolfram Notebook. Медиа: video/mp4  ↑ 
6. Slicing Silhouettes of Jupiter: Processing JunoCam ImagesПт., 12 янв.[−]
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 highres 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 colorfiltered, 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 nearinfrared. The first three of these are taken on one spacecraft rotation (about two revolutions per minute), and the nearinfrared image is taken on the second rotation. The final image product stitches all the singlefilter 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:
?
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_V01red.png"];
?
{imgRed, imgGreen, imgBlue}
To assemble an RGB image from these bands, I use ColorCombine:
?
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:
?
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 colorcombined 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:
?
newMask = Binarize[jupInit, {0.01, 1}]
When I apply this mask, I get:
?
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:
?
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}
]
]];
?
stretchImage[IMAGE]
I use the parameter values I found with the Manipulate to create an adjusted image:
?
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:
?
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
]
]];
?
deconvolveImage[jupadj]
Again, I use the blur correction I found interactively to make an unblurred image:
?
jupUnblur =
ImageDeconvolve[jupadj, GaussianMatrix[1.7],
Method > "RichardsonLucy"];
And as a sanity check, I ll see how these changes look side by side:
?
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:
?
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):
?
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:
?
seeds
Using these seeds, I can do segmentation programmatically:
?
Colorize[label = ImageForestingComponents[filtered, seeds, 2]]
With the regions segmented, I create a mask for the Great Red Spot:
?
mask = Colorize[DeleteBorderComponents[label]]
I apply this mask to the image:
?
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 rightclick menu helped me navigate the image to find necessary coordinates for creating this numerical boundary:
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:
As well as where the x coordinate within that same region is at a minimum:
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:
?
x = Range[144, 275, .1];
y = Range[264, 350, .1];
I construct the major and minor axes:
?
xRadius = (Max[x]  Min[x])/2;
yRadius = (Max[y]  Min[y])/2;
And I approximate the center:
?
center = {Min[x] + xRadius, Min[y] + yRadius}
And finally, I create the bounding ellipse:
?
bounds = Graphics[{Thick, Blue,
RegionBoundary[
Ellipsoid[center, {xRadius, yRadius}]
]}]
This bounding ellipse is applied to the image:
?
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 builtin properties for Jupiter (and any other planet in our solar system) already present in the language itself, readily available for computation:
?
\!\(\*
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!
?
surface =
Entity["Planet", "Jupiter"][
EntityProperty["Planet", "CylindricalEquidistantTexture"]] //
NestList[Sharpen, #, 2] //
#[[1]]
Using this projection, I can map it to a spherical graphic primitive:
?
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]
]
?
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.  ↑ 
7. Goodbye, 2017! It Was a Marvelous Year for Wolfram ResearchЧт., 04 янв.[−]
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, WolframAlpha pumping up its alreadyunmatched 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:
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
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
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 StepbyStep Solutions in WolframAlpha
Our post about WolframAlpha Pro upgrades was one of the most popular of the year. And all the web traffic around WolframAlpha s development of stepbystep 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 forwardthinking teachers recommend WolframAlpha Pro products.
Notebooks in Your Pocket—WolframPlayer for iOS Is Now Shipping
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 Builtin Components
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 builtin 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
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 (hardwareintheloop) simulation.
CaseUse 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
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
Another Best Picture nominee in 2017 was Arrival, a film for which Stephen and Christoper Wolfram served as scientific advisors. Stephen wrote an oftencited 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
Wolfram celebrated the birthday of the late, great Muhammad Ali with a blog post from one of our data scientists, Jofre EspigulePons. Using charts and graphs from histograms and network plots, EspigulePons examined Ali s boxing career, his opponent pool and even his poetry. This tribute to the boxing icon was one of the mostloved blog posts of 2017.
Analyzing Social Networks of Colonial Boston Revolutionaries with the Wolfram Language
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
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
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!  ↑ 
8. Spikey Bird: Creating a Flappy Bird Mod in the Wolfram LanguageЧт., 28 дек. 2017[−]
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 wellknown 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:
spikey = RemoveBackground[
ImageCrop[
Rasterize[Style["\[MathematicaIcon]", FontSize > 200],
ImageResolution > 700]]];
spikey = ImageResize[spikey, ImageDimensions[spikey]/40]
Considering the season, let s make Spikey festive:
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:
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:
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:
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:
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:
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 fourargument 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:
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
]
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:
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:
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:
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:
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:
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.
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]
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:
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:
accumulatedDistance =
Prepend[Accumulate[Norm /@ Differences[cyclic]], 0.]
Linearly interpolate the x and y coordinates. This creates a function for our walk around the perimeter:
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:
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:
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:
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:
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
]
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:
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:
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:
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:
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:
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
]
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 notsohidden 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:
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:
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}}]\)};
cityStyles =
Prepend[SetAlphaChannel[ImageRestyle[city, #],
AlphaChannel[city]] /@ artStyles, city];
groundStyles =
Prepend[ImageRestyle[ground, #] /@ artStyles, ground];
groundStyles =
Prepend[ImageRestyle[ground, #] /@ artStyles, ground];
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]};
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:
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:
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:
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:
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
]
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:
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.  ↑ 
9. Computational Gastronomy: Using the Wolfram Language to Prepare a Sumptuous Holiday FeastПт., 22 дек. 2017[−]
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 WolframAlpha, 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 = 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.
(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.
✕
emailBody =
"We're looking forward to having you over for Christmas dinner! As \
we'll be hosting a decentsized 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 WolframAlpha, and I know that the Wolfram Language has access to the treasure trove of content in WolframAlpha. So I thought I’d play around with this resource.
Data visualizations come in many forms these days, and the Wolfram Language provides numerous builtin functions to create them, such as WordCloud and ImageCollage. But I thought I’d take a holidayfood 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.
✕
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 popup of the associated food.
✕
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"]}}
]

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 lookup 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.
Before I ran to the grocery store, I wanted a backup plan in case they didn’t have any nonorange 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 secondbest substitute. As someone who taught cooking classes for several years, I know that one of the most common mealkillers 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!
(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 WolframAlpha Examples page for food and nutrition. There you can see the wide variety of WolframAlpha query fields on cooking, ingredients and other foodrelated data, as well as foodthemed WolframAlpha blog posts. If the WolframAlpha 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:
 ↑ 
10. Creating Mathematical Gems in the Wolfram LanguageЧт., 14 дек. 2017[−] 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” 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”
✕
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”
✕
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” 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” 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 inversestereographically 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:
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.  ↑ 
Powered by
 