Wolfram BlogПн., 19 февр. Текст источника в новой вкладке
News, views, and ideas from the front lines at Wolfram Research.

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, fact-based questions directed toward an unstructured collection of texts (with a technology very different from that of Wolfram|Alpha, 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, state-owned 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 all-time 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 well-established techniques for information retrieval and state-of-the-art 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 TFIDF-based 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 cutting-edge 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 Wolfram|Alpha. 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 300-Dimensional 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 300-Dimensional Word Vectors Trained on Wikipedia and Gigaword 5 Data. A second part of the neural network produces a higher-level 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 state-of-the-art models of question answering, the neural network of FindTextualAnswer uses a two-way 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 question-aware representation of the text and a context-aware 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 out-of-vocabulary 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 context-question representation, again with recurrent layers aggregating evidence to produce a higher-level 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 Wolfram|Alpha, 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.Комментарии (0)

2. Wolfram News Roundup: Neural Net Connectivity, Gravitational Wave Discoveries and MoreЧт., 08 февр.[−]

Net framework

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:

“Apache MXNet in the Wolfram Language”

Machine training progress animation

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 behind-the-scenes glimpse of a high-level 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.

“Scientists Pioneer Use of Deep Learning for Real-Time Gravitational Wave Discovery”

Deep learning readout

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 real-time gravitational wave discovery. Daniel used the Wolfram Language to build the deep learning framework called Deep Filtering. Read more.

“Sit Down at a Periodic Table That Holds Samples of Every Element”

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.

“A Train Station with Walls Designed Using Cellular Automata ‘Rule 30′”

Cambridge North train station

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.

Комментарии (0)

3. Cultivating New Solutions for the Orchard-Planting 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 tic-tac-toe, three-in-a-row 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 best-known 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 orchard-planting problem, Wikipedia s orchard-planting problem and the On-Line 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 modulus-17 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 4-configuration. 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 4-configuration 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 best-known 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 best-known 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 self-dual configuration exists where the point set is identical to the line set. I managed to find the following 24-point 3-configuration. 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 order-27, self-dual 4-configuration 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 three-in-a-row, frequently known as elliptic curve theory, but I ll mostly be veering into geometry. Cubic Curves and Zero-Sum 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 zero-sum. 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 zero-sum 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 mirror-symmetric zero-sum 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 elegant-looking solution for the 15-tree 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 14-point 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 16-point, 37-line 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 15-solution with an abnormal amount of parallelism, enough to match the sporadic 16-point solution. How did I find it? Orchard-Planting Polynomials Here are coordinates for the positive points up to 4 in the mirror-symmetric and skew-symmetric 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 orchard-planting 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 orchard-planting 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 orchard-planting 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 lower-right corner where the green curve is passing through many black curves? That's the location of the sporadic 16-point 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 elegant-looking solutions. Unsolved Problems Looking for unsolved problems of the orchard-planting variety? Here are several I suggest: Do more sporadic solutions exist for the three-orchard problem? Can 11- and 19-point solutions be found with partial zero-sum geometry? Do better solutions exist for four-orchard solutions on 17 or more points? Do smaller 3- and 4-configurations exist where the sets of the barycentric coordinates for the points and lines are the same? Does a 5-configuration exist where the sets of the barycentric coordinates for the points and lines are the same? What are best solutions for the five-orchard problem? Is there a good method for generating orchard-planting polynomials? And if you'd like to explore more recreational mathematics, check out some of the many entries on the Wolfram Demonstrations Project.Комментарии (2)

4. The Wolfram Language Bridges Mathematics and the ArtsПт., 26 янв.[−]
Every summer, 200-some 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, SNO-Ball 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 3D-Printed Rollers for Frieze Pattern Cookies. With a paragraph of Wolfram Language code, George translates images to 3D-printed 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 cookie-roller 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 3D-printed 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 large-scale resin 3D prints. Many of his forms result from Wolfram Language explorations. Here, for example, are some of Duffy s explorations of a fifth-degree polynomial that describes a Calabi–Yau space, important in string theory: Duffy plotted one instance of that function in Mathematica, 3D-printed 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 bronze-infused, 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 Mathematica-designed 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 3D-printed modules that can be assembled to make a lost-plastic bronze casting of a compound of five tetrahedra: The finished casting should look something like this (but mirror-reversed): 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 3D-printed 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 high-power 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 Комментарии (4)

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 in-depth 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 location-independent. 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 R-rated. 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 10-step 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 (half-marathon 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 colon-separated 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 half-marathon 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 10-kilometer 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 fast-paced, 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 display-friendly 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 eight-hour 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 two-dimensional 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 Wolfram|Alpha 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, Wolfram|Alpha 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. Wolfram|Alpha 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 nine-minutes-per-mile 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 guilt-free beers that are typically offered after a marathon race, or 17 servings of 2 2-inch 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 last-minute, 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 mid-race. 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

Комментарии (0)

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 high-res images of Jupiter s apparent surface of gases back to Earth for study in order to answer some of the questions we have about our corner of the universe. The images captured by the Juno spacecraft give us a complete photographic map of Jupiter s surface in the form of color-filtered, surface patch images. Assembling them into a complete color map of the surface requires some geometric and image processing. Preprocessing the Images Images from the JunoCam were taken with four different filters: red, green, blue and near-infrared. The first three of these are taken on one spacecraft rotation (about two revolutions per minute), and the near-infrared image is taken on the second rotation. The final image product stitches all the single-filter images together, creating one projected image. NASA has put together a gallery of images captured through the JunoCam that contains all the pieces used for this procedure, including the raw, unsorted image; the red, green and blue filtered images; and the final projected image. Let s first import the specific red, green and blue images: ? imgBlue = Import["~/Desktop/JunoImages/ImageSet/JNCE_2017192_07C00061_V01-\ blue.png"]; imgGreen = Import["~/Desktop/JunoImages/ImageSet/JNCE_2017192_07C00061_V01-\ green.png"]; imgRed = Import[ "~/Desktop/JunoImages/ImageSet/JNCE_2017192_07C00061_V01-red.png"]; ? {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 color-combined image. To prevent the shadowing on the foreground image from disturbing any further analysis, the brightness needs to be uniform throughout the image. I first create a mask that limits the correction to the white area: ? 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 right-click 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 built-in 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.Комментарии (1)

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, Wolfram|Alpha pumping up its already-unmatched educational value and a host of features and capabilities related to these releases. We ll start with the Wolfram Language releases. The R D Pipeline Continues: Launching Version 11.1 Stephen Wolfram says it s a minor release that s not minor. And if you look at the summary of new features, you ll see why: 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 Step-by-Step Solutions in Wolfram|Alpha Our post about Wolfram|Alpha Pro upgrades was one of the most popular of the year. And all the web traffic around Wolfram|Alpha s development of step-by-step solutions is not surprising when you consider that this product is the educational tool for anyone studying (or teaching!) mathematics in high school or early college. Read the post to find out why students and forward-thinking teachers recommend Wolfram|Alpha Pro products. Notebooks in Your Pocket—WolframPlayer for iOS Is Now Shipping John Fultz, Wolfram s director of user interface technology, announced the release of a highly anticipated product Wolfram Player for iOS. The beta is over, and we are now shipping Wolfram Player in the App Store. Wolfram Player for iOS joins Wolfram CDF Player on Windows, Mac and Linux as a free platform for sharing your notebook content with the world. Now Wolfram Notebooks are the premium data presentation tool for every major platform. Announcing SystemModeler 5: Symbolic Parametric Simulation, Modular Reconfigurability and 200 New Built-in Components The Wolfram MathCore and R D teams announced a major leap for SystemModeler. As part of the 4.1, 4.2, 4.3 sequence of releases, we completely rebuilt and modernized the core computational kernel of SystemModeler. Now in SystemModeler 5, we re able to build on this extremely strong framework to add a whole variety of new capabilities. Some of the headlines include: Support for continuous media such as fluids and gases, using the latest Modelica libraries Almost 200 additional Modelica components, including Media, PowerConverters and Noise libraries Complete visual redesign of almost 6,000 icons, for consistency and improved readability Support for new GUI workspaces optimized for different levels of development and presentation Almost 500 built-in example models for easy exploration and learning Modular reconfigurability, allowing different parts of models to be easily switched and modified Symbolic parametric simulation: the ability to create a fully computable object representing variations of model parameters Importing and exporting FMI 2 models for broad model interchange and system integration Communication in Industry 4.0 with Wolfram SystemModeler and OPC UA Earlier last year Markus Dahl, applications engineer, announced another advancement within the SystemModeler realm the integration of OPC Unified Architecture (OPC UA). Wolfram SystemModeler can be utilized very effectively when combining different Modelica libraries, such as ModelPlug and OPCUA, to either create virtual prototypes of systems or test them in the real world using cheap devices like Arduinos or Raspberry Pis. The tested code for the system can then easily be exported to another system, or used directly in a HIL (hardware-in-the-loop) simulation. Case-Use Blogs That Hit Big In 2017 we had some blog posts that made quite a splash by showing off Wolfram technology. From insights into the science behind movies to timely new views on history, the Wolfram Language provided some highlight moments in public conversations this year. Let s check out a few Hidden Figures: Modern Approaches to Orbit and Reentry Calculations 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 often-cited blog post about the experience, Quick, How Might the Alien Spacecraft Work?. On the set, Christopher was tasked with analyzing and writing code for a fictional nonlinear visual language. On January 31, he demonstrated the development process he went through in a livecoding event broadcast on LiveEdu.tv. This livecoding session garnered almost 60,000 views. Exploring a Boxing Legend s Career with the Wolfram Language: Ali at 75 Wolfram celebrated the birthday of the late, great Muhammad Ali with a blog post from one of our data scientists, Jofre Espigule-Pons. Using charts and graphs from histograms and network plots, Espigule-Pons examined Ali s boxing career, his opponent pool and even his poetry. This tribute to the boxing icon was one of the most-loved blog posts of 2017. Analyzing Social Networks of Colonial Boston Revolutionaries with the Wolfram Language 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!Комментарии (2)

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 well-known mobile game with a simple yet captivating interactive element that has helped many people kill a lot of time. The goal of the game is to navigate a series of pipes, where each successful pass adds a point to your score. The challenge is that the character, the bird, is not so easy to control. Gravity is constantly pulling it down. You flap to boost yourself upward by repeatedly tapping the screen, but you must accurately time your flaps to navigate the narrow gaps between pipes. So follow along and see what kind of graphical gaming mayhem is possible in just a few short lines of code! Creating Spikey I m going to make Spikey Bird by implementing the gameplay features of Flappy Bird. Our character is going to be Spikey: 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 four-argument syntax for Inset so you can specify the size in the fourth argument. Otherwise, the inset object s size does not scale with the image size of the graphics. Putting the pieces together in an instance of DynamicModule yields our first basic interface and keeps the variables locally scoped. You can play around with different combinations of gameplay factors, even while the disk is in motion: 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 not-so-hidden developers' tools. If you got rid of the developers' tools, then the code would be considerably shorter! Here are some suggestions you can try on your own: Play the game using only the "Invert Gravity" button. Modify the blocks to fall from the top of the screen to the bottom (similar to classic "flight" games). Change the obstacles to randomly generated polygons instead of rectangles, and add more of them! Add sound effects in appropriate places using EmitSound. Bonus Suggestion 1: Using Sprites Instead of Primitives I'm not an artist, but the Wolfram Language makes it simple to include bitmap graphics. For example, I can screen capture images from the internet and import them. Like I did with Spikey, it's often sufficient to just use ImageCrop and RemoveBackground, then use Inset to include it in a graphics expression. It's important to keep the image size small, though, or updates to the image can take time to render for each update. The polygons will still be needed for hit detection, but the images sit on top of them: 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.Комментарии (2)

9. Computational Gastronomy: Using the Wolfram Language to Prepare a Sumptuous Holiday FeastПт., 22 дек. 2017[−]

Plated meal restyled

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

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

Building a Christmas Dinner Survey

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

Setting Up a Databin

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

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

foodSurveyDatabin code

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

Creating a Web Form

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

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

Data Drop screenshot

Christmas dinner survey screen shot

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

Sending Out Emails Programmatically

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

emailList codeemailBody code

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

A European Holiday Food Map

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

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

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

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

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

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

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

euroHolidayFoodsCloudObject code

euroHolidayFoodsCloudObject =
CopyFile["EuropeanChristmasDishImages.m", euroHolidayFoodsCloudObject];
SetPermissions[euroHolidayFoodsCloudObject, "Public"];
euroHolidayFoods = CloudGet[euroHolidayFoodsCloudObject]

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

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

GeoGraphics Europe map with holiday foods

     {image = Import[#ImageURL]},
            {{.2, .2}, {.8, .8}},
            DataRange -> {{0, 1}, {0, 1}}

           i_Image /; (ImageDimensions[i][[1]] > 1000) :>
            ImageResize[i, 500]
          {3, 3}
       Framed[Row@{#DishName, "   ", image}, FrameStyle -> Gray]]
    & /@ euroHolidayFoods
 GeoRange -> \!\(\*
DynamicModuleBox[{Typeset`query$$ = "europe", Typeset`boxes$$ =
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" -> {}}},
AlphaIntegration`LinguisticAssistantBoxes["", 4, Automatic,
Dynamic[Typeset`querystate$$]], StandardForm],
ImageSizeCache->{217., {7., 17.}},
        Typeset`query$$, Typeset`boxes$$, Typeset`allassumptions$$,
         Typeset`assumptions$$, Typeset`open$$, Typeset`querystate$$}],
 ImageSize -> Large,
 GeoRangePadding -> {{Quantity[-50, "Kilometers"],
    Quantity[-600, "Kilometers"]}, {Quantity[-250,
     "Kilometers"], -Quantity[575, "Kilometers"]}}

Europe holiday foods map

Computational Solutions to Culinary Conundrums

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

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

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

Carrot comparisons screen shot

Vegetable PLUs screen shot

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

visualizeReplacements carrot output

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

Keep Wolfram in Your Kitchen

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

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

Appendix: Creating the Lead Image

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

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

Lead image restyle

Комментарии (0)

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 VisionRise Up“Stereo Vision” and “Rise Up”

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

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

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

Stay Upright
“Stay Upright”

"Stay Upright" code

DynamicModule[{n = 60, a = \[Pi]/4,
  viewpoint = {1, 1.5, 2.5}, \[Theta] = 1.19, r = 2.77, plane,
  cols = RGBColor /@ {"#f43530", "#e0e5da", "#00aabb", "#46454b"}},
 plane = NullSpace[{viewpoint}];
    Table[{Blend[cols[[;; -2]], r/\[Pi]],
       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" code

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

With[{n = 30, m = 22, viewpoint = 5 {1, 0, 0},
  cols = RGBColor /@ {"#2292CA", "#EEEEEE", "#222831"}},
        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 CarpetSquare Up“Magic Carpet” and “Square Up”

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

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

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

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

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

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

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

Clay at GIF competition

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

Комментарии (0)

Каталог RSS-каналов (лент) — RSSfeedReader
Всего заголовков: 10
По категориям:
Все заголовки
Astronomy (1)
* Best of Blog * (1)
Computational Thinking (2)
Data Analysis and Visualization (2)
Data Repository (2)
Design (1)
Developer Insights (1)
Education (1)
History (1)
Image Processing (1)
Mathematics (2)
Other Application Areas (1)
Recreational Computation (4)
SystemModeler (1)
Wolfram Cloud (2)
Wolfram Language (8)
Wolfram News (1)
Wolfram|Alpha (3)
По датам:
Все заголовки
2018-02-15, Чт. (1)
2018-02-08, Чт. (1)
2018-02-02, Пт. (1)
2018-01-26, Пт. (1)
2018-01-18, Чт. (1)
2018-01-12, Пт. (1)
2018-01-04, Чт. (1)
2017-12-28, Чт. (1)
2017-12-22, Пт. (1)
2017-12-14, Чт. (1)
По авторам:
Все заголовки
Christopher Carlson (1)
Ed Pegg Jr (1)
Eila Stiegler (1)
J?r?me Louradour (1)
Jesse Dohmann (1)
Kevin Daily (1)
Micah Lindley (1)
Michael Gammon (2)
Swede White (1)