Essays, Posts & Presentations

The Ultimate Team Generator with the Wolfram Language

Bob Sandheinrich

Author

Bob Sandheinrich

Title

The Ultimate Team Generator with the Wolfram Language

Description

Setting up teams, including player baggage requests, for an Ultimate Frisbee league using Wolfram graph and network tools. See the code to import and interpret the data, use the Dataset function, create a graph, group into teams, export the data.

The Ultimate Team Generator with the Wolfram Language

August 2, 2019

Bob Sandheinrich, Development Manager, Document & Media Systems

Every summer, I play in a recreational Ultimate Frisbee league—just “Ultimate” to those who play. It’s a fun, relaxed, coed league where I tend to win more friends than games.

The league is organized by volunteers, and one year, my friend and teammate Nate was volunteered to coordinate it. A couple weeks before the start of the season, Nate came to me with some desperation in his voice over making the teams. The league allows each player to request to play with up to eight other players—disparagingly referred to as their “baggage.” And Nate discovered that with over 100 players in a league, each one requesting a different combination of teammates, creating teams that would please everyone seemed to become more complicated by the minute.

Luckily for him, the Wolfram Language has a suite of graph and network tools for things like social media. I recognized that this seemingly overwhelming problem was actually a fairly simple graph problem. I asked Nate for the data, spent an evening working in a notebook and sent him the teams that night.

Using the Wolfram Language worked so well that—though it’s been years since I first helped out Nate, and the league coordinator has changed—I can count on an annual email volunteering me to make the teams again. And each year, I’ve been able to dig out my notebook and make teams, regularly adding improvements along the way.

Until Nate showed me his problem, I didn’t realize how tricky a situation this could be. Because baggage requests don’t have to be mutual, you can end up with chains of connected players that are larger than the acceptable size of a team. By just looking at Nate’s spreadsheet, it was nearly impossible to divine which baggage requests needed to be denied to make teams.

In addition to determining which baggage requests to decline, the process involves importing and interpreting datasets, grouping cores of players so that teams have similar metrics and exporting results for the league to distribute.

Some Notes

I’ve anonymized the data here, which was fun to do with Wolfram|Alpha. In only a couple lines of code, I replaced the all of the players’ names with notable people of the same gender from the Wolfram Knowledgebase. You can find the code to create this “dummy data” in the downloadable notebook for this post.

In the graph visualizations, I deliberately omitted the players’ names. I wanted to avoid the taint of giving myself an advantage, as I’m also playing in this league. Typically, I don’t know which team I am on until the very end. If any other players in the league are reading this and have doubts, allow my combined 2016–2018 win-loss record of 7–38 serve as definitive proof that if there is a bias, it is decidedly anti-Bob.

Importing the Data

My first step is to grab the data from the league website. There are two sets of data to import: a list of registered players and a list of baggage requests.

Here I have stored anonymized copies of the player and baggage data as cloud objects:

In[]:=

$urls={"https://www.wolframcloud.com/obj/bobs/Ultimate2019DummyPlayers.html","https://www.wolframcloud.com/obj/bobs/Ultimate2019DummyBaggage.html"};

Player List

Since I started work on the Wolfram Data Repository a few years ago, I’ve learned a universal truth: any general, automated data importer will quickly fail to automatically import real data. In the real world, it’s all edge cases.

Naively optimistic nonetheless, I attempt to import the player data directly from the webpage using the automated tools in

Import

[url,"FullData"].

The failure originates with two columns with checkboxes defined by custom CSS that are not properly captured by the HTML importer. Here is the code that failed:

In[]:=

autoplayers=Import[$urls[[1]],"FullData"][[2,2,1]];Short[autoplayers]

Out[]//Short=

{{1},{{05.05.19,3253,13166,3,,26,Female},152}}

Interpret the Data

I use these interpretation tools for converting each column into the Wolfram Data Framework (WDF).

In[]:=

interpretRawData[raw_]:=interpretRow/@getDataRows[raw]interpretRow[row_]:=MapIndexed[interpretValue[##]&,row]interpretValue[val_,{Key[k_]}]:=interpretValue[val,k]interpretValue[val_,"Entered"]:=DateObject[{val,{"Month",".","Day",".","YearShort"}}]interpretValue[val_,"Name"]:=ImportString[StringReplace[StringTrim[val],"\n"|"\t"""],"HTML"]interpretValue[val_,"age"|"pow"|"Mem ID"]:=ToExpression[val]interpretValue[val_,"exp"|"skl"|"ath"]:=ToExpression[StringDrop[val,1]]interpretValue[val_,"paid"|"mgr"]:=Interpreter["Boolean"][val]interpretValue[val_,_]:=valgetDataKeys[raw_]:=StringReplace[First@First[raw],Whitespace""]getDataRows[raw_]:=With[{k=getDataKeys[raw]},AssociationThread[k#]&/@raw[[2]]]

This shows that none of the players have paid. Since I paid, I know there’s a problem!

In[]:=

dataFromAutoImport=interpretRawData[autoplayers];

In[]:=

Lookup[dataFromAutoImport,"paid"]//Counts

Out[]=

False153

As in most real-world data problems, some manual data work is required. In the following code, I retrieve the data with a web request and then import it into WDF by manually parsing the HTML and formatting the values.

In[]:=

resp=URLRead[First@$urls]

Out[]=

HTTPResponse

Status: OK

Content type: text/html;charset=UTF-8



In[]:=

html=resp["Body"];

The response contains a raw HTML document:

In[]:=

Snippet[html,4]

Out[]=

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"><html xmlns="http://www.w3.org/TR/REC-html40"><head>

To parse the HTML directly, I need more utilities.

In[]:=

getFirstTable[html_]:=First[StringCases[html,"<table"~~Shortest[___]~~"</table"]]getTableRows[table_]:=StringCases[table,"<tr"~~Shortest[___]~~"</tr"]getTableKeys[rows_]:=StringReplace[StringCases[First[rows],"<th"~~Shortest[___]~~">"~~k:Shortest[__]~~"</th"k],"<"~~Shortest[___]~~">"""]getRowValues[row_]:=StringReplace[StringCases[row,"<td"~~Shortest[___]~~">"~~k:Shortest[___]~~"</td"k],"<"~~cont:Shortest[___]~~">":>If[StringFreeQ[cont,"check"],"","True"]]importPlayerTable[html_]:=With[{rows=getTableRows[getFirstTable[html]]},With[{keys=getTableKeys[rows]},interpretRow[AssociationThread[keys->getRowValues[#]]]&/@Rest[rows]]]

In[]:=

importeddata=importPlayerTable[html];

Now, "paid" shows the correct values.

In[]:=

Lookup[importeddata,"paid"]//Counts

Out[]=

True143,False10

Dataset

I like working with

Dataset

. It makes it easy to query the data as well as provides a nice visualization in a table.

In[]:=

playerdata=Dataset[importeddata]

Out[]=

Entered	Mem ID	Leg ID	Name	paid	pow	Slctdvsn	exp	skl	ath	mgr	age	Gender
Sun 5 May 2019 00:00:00	3253	13166	Dawn Black	True	74	0	3	7	8	False	26	Female
Mon 22 Apr 2019 00:00:00	1934	12905	Hannah Frank	True	74	0	4	6	8	False	29	Female
Mon 6 May 2019 00:00:00	866	13172	Nancy Robertson	True	73	0	3	8	8	False	36	Female
Tue 16 Apr 2019 00:00:00	405	12754	Liesel Westermann	True	71	0	3	8	6	False	33	Female
Fri 3 May 2019 00:00:00	4639	13105	Darisleydis Amador	True	68	0	5	5	6	False	31	Female
Wed 10 Apr 2019 00:00:00	3537	12630	Maria Angelica	True	68	0	4	7	7	False	24	Female
Wed 1 May 2019 00:00:00	3156	13038	Melanie Brown	True	66	0	3	6	7	False	25	Female
Tue 16 Apr 2019 00:00:00	3814	12762	Lena Söderberg	True	65	0	3	7	7	False	28	Female
Wed 10 Apr 2019 00:00:00	691	12548	Julie Pietri	True	65	0	3	8	4	True	38	Female
Wed 10 Apr 2019 00:00:00	207	12565	Mengyu Wang	True	65	0	2	7	6	False	33	Female
Tue 30 Apr 2019 00:00:00	2613	13023	Guo Jingjing	True	63	0	4	7	7	False	20	Female
Wed 10 Apr 2019 00:00:00	629	12557	Susan Moon	True	60	0	2	6	7	True	35	Female
Sun 14 Apr 2019 00:00:00	3502	12705	Irina Buryachok	True	60	0	1	7	7	False	34	Female
Thu 11 Apr 2019 00:00:00	2924	12654	Maria Garcia	True	59	0	2	7	7	True	29	Female
Wed 17 Apr 2019 00:00:00	3993	12793	Christine Devine	True	56	0	3	6	6	False	24	Female
Mon 6 May 2019 00:00:00	3922	13186	Rose Zwi	True	55	0	2	6	6	False	23	Female
Thu 18 Apr 2019 00:00:00	2068	12804	Jennifer Grünwald	True	53	0	2	6	6	False	30	Female
Wed 8 May 2019 00:00:00	3578	13229	JuYoung Park	True	52	0	1	5	7	False	26	Female
Fri 3 May 2019 00:00:00	4640	13110	Luciana Pedraza	True	52	0	1	8	8	False	22	Female
Sun 14 Apr 2019 00:00:00	3891	12699	Ellen Spertus	True	52	0	2	7	7	False	25	Female
showing 1–20 of 153

In case manually parsing HTML was not messy enough, the chummy Ultimate community of St. Louis has another trick. Players know that instead of properly entering their requests into the registration form, they can just email the league coordinator and tell them what they want. To help sort out these emails, I made a utility function for finding players by name or ID.

In[]:=

findPlayer[str_String]:=playerdata[Select[StringContainsQ[#Name,str,IgnoreCaseTrue]&]]findPlayer[n_Integer]:=playerdata[Select[#["Mem ID"]===n&]]playerPosition[n_Integer]:=First@Flatten@FirstPosition[playerdata,n]

For example, Maria Garcia accidentally registered as a manager (or captain). Then she emailed to say she does not want that responsibility.

In[]:=

findPlayer["Garcia"]

Out[]=

Entered

Mem ID

Leg ID

Name

paid

pow

Slctdvsn

exp

skl

ath

mgr

age

Gender

Thu 11 Apr 2019 00:00:00

2924

12654

Maria Garcia

True

Female

In[]:=

p=playerPosition[2924]

Out[]=

In[]:=

importeddata[[p,"mgr"]]=False

Out[]=

False

After several other manual adjustments, I recreate the dataset.

In[]:=

playerdata=Dataset[importeddata];

Then I get a list of the unique IDs that we will use to create a graph.

In[]:=

ids=Normal[playerdata[All,"Mem ID"]];

In[]:=

Length[ids]

Out[]=

153

Baggage

For the baggage data, my optimism pays off; the automatic importing works!

In[]:=

rawbaggage=Import[$urls[[2]],"Data"];

In[]:=

Length[rawbaggage]

Out[]=

408

The data is very simple, just pairs of ID numbers.

In[]:=

Short[rawbaggage]

Out[]//Short=

{{196,190},{196,3187},{207,723},{207,64},{207,2318},398,{4638,3966},{4641,4631},{4641,4633},{4641,4630},{4644,3778}}

In[]:=

edges=DirectedEdge@@@rawbaggage;

Create a Graph Including Baggage

Now we’ve reached the interesting part, where the

Graph

visualization and manipulation makes a hard problem easy.

I start by creating one large graph, where each vertex is a player and each edge is a baggage request. Because baggage requests need not be mutual, it’s a directed graph.

To add more information to the visualization, I style the graph using green for men, orange for women and large vertices for captains. The slightly darker colors represent people who have not yet paid. I label the vertices with the unique member ID ("Mem ID") property.

Initialize Symbols

In[]:=

$numTeams=8;coreIDs={};teams=teamlist=List/@Range[$numTeams];selected=0;

Graph Styling Tools

In[]:=

teamSummary[tn_]:=teamsummary[tn, teams[[tn]]]teamsummary[tn_, team_]:=With[{rows=playerdata[Select[MemberQ[team,#["Mem ID"]]&]]},Style["Team "<>ToString[tn]<>": "<>ToString[Length[team]]<>" Players\n"<>TextString@Normal@Counts[rows[All,"Gender"]]<>"\nMedian Age = "<>ToString[N@Median[rows[All,"age"]]]<>"\nMean Power = "<>ToString[N@Mean[rows[All,"pow"]]], 14]]Clear[$genderColors,$bigCaptains,$nameLabels,$idLabels];$idLabels:=($idLabels=Thread[idsids]);$genderColors:=($genderColors=Normal[playerdata[All,#["Mem ID"]If[!TrueQ[#paid],Darker,Identity]@Switch[#Gender,"Male",Green,"Female",Orange,_,Print["g"#Gender];Black]&]])$bigCaptains:=($bigCaptains=Normal[playerdata[All,#["Mem ID"]If[TrueQ[#mgr],1,.4]&]])$nameLabels:=($nameLabels=Normal[playerdata[All,#["Mem ID"]StringTake[#Name,UpTo[25]]&]])

Immediately there’s a big problem: about a third of the eight-team league is connected in a continuous “baggage chain.” This is pretty typical of my yearly experience. In the worst year so far, over half the players were connected to each other.

In[]:=

originalgraph=Graph[ids,edges,VertexLabels$idLabels,VertexStyle$genderColors,VertexSize$bigCaptains]

Out[]=

Determine Desired Team Shape

Before I start cutting those groups apart, I compute some quick statistics about how the average team should look.

Number of Players

In[]:=

N[Length[ids]/$numTeams]

Out[]=

19.125

Number of Women per Team

In[]:=

N@Length[playerdata[Select[#Gender"Female"&]]]/$numTeams

Out[]=

4.875

Average Age and Power

In[]:=

{N@playerdata[Mean,"age"],playerdata[Median,"age"]}

Out[]=

{30.7451,29}

In[]:=

N@playerdata[Mean,"pow"]

Out[]=

55.1961

Baggage-Breaking Chains

These simple statistics give me an idea of what size group I can allow to stay. To split the large graph into connected groups that I call “cores,” I use

WeaklyConnectedGraphComponents

In[]:=

connectedgraphs=WeaklyConnectedGraphComponents[originalgraph];

In[]:=

VertexCount/@connectedgraphs

Out[]=

{45,23,11,10,9,7,7,6,6,4,4,3,3,2,2,1,1,1,1,1,1,1,1,1,1,1}

In[]:=

subgraph=First@connectedgraphs

Out[]=

Sometimes it’s hard to pick out the exact edges from looking at the graph. That’s where

EdgeList

comes in handy.

In[]:=

EdgeList[subgraph,2180_|_2180]

Out[]=

{21801931,21804603,19312180,46032180,21802851,21803098,21803547}

Once I gather a list of edges that I think are smart to cut, I use

HighlightGraph

to verify. The list here includes two edges I picked from the second connected component as well.

In[]:=

cuts={40327,206511,315611,21803098,21802851,21803547,744629,744645};

In[]:=

HighlightGraph[subgraph,DirectedEdge@@@cuts]

Out[]=

After removing those edges, the graph looks much more manageable.

In[]:=

modifiedgraph=EdgeDelete[originalgraph,DirectedEdge@@@cuts]

Out[]=

Group Cores into Teams

I’m done being the bad guy, splitting people up. Now I get to be the nice guy, bringing folks together. This involves grouping the connected subgraphs, or what I call “cores” of players, intelligently to make nice teams.

The problem of how to group those cores into teams is not trivial. There are several dimensions to consider:

◼

Each team should have similar numbers of men and women

◼

Each team should have a captain

◼

Teams should be as evenly matched as possible

The last item is tricky. The registration data contains three subjective, self-evaluation metrics: “athleticism,” “skill” and “experience,” as well as a metric called “power,” which is a linear weighting of the other three. However, these tend to be better measures of humility (or perhaps gamesmanship) than actual ability. The most objective measure that has some bearing on ability is age. This year, players in the league range from 15 to 58. Experience shows that teams made up of too many players at either the young or old ends of the range tend to be less competitive.

I’ve played around with methods to automate this process by optimizing a utility function, but have not had success yet. Maybe I’ll do that in a year or two and write a follow-up. Maybe you, dear reader, will do it for me. For now, I’ll show you the notebook GUI I made for manually sorting cores into teams.

In[]:=

coreIDs=WeaklyConnectedComponents[modifiedgraph];

For a Fun Visual: CommunityGraphPlot

In[]:=

CommunityGraphPlot[modifiedgraph,Labeled[#,Style[ToString[Length[#]]<>" Players",24]]&/@Take[coreIDs,$numTeams],VertexLabels$idLabels,VertexStyle$genderColors,VertexSize$bigCaptains,ImageSize700]

Out[]=

Create a GUI for Building Teams from Cores

First, I define a list of buttons for selecting teams, showing the team graph on each button.

In[]:=

dynamicTeamGraphButtons[fullgraph_]:=Dynamic[Button[With[{team=Flatten[coreIDs[[teamlist[[#]]]]]},Subgraph[fullgraph,team, PlotLabelteamsummary[#,team],VertexLabels$idLabels,VertexStyle$genderColors,VertexSize$bigCaptains, ImageSize200]],selected=#,AppearanceIf[selected#,"Pressed",Automatic]],TrackedSymbols{teamlist,selected}]&/@Range[$numTeams]

To remove a core from the selected team:

In[]:=

moveCore[tn_, selected_]:=(teamlist=teamlist/.tnNothing)/;MemberQ[teamlist[[selected]],tn]

To add a core to the selected team:

In[]:=

moveCore[tn_,selected_]:=(teamlist=teamlist/.tnNothing;AppendTo[teamlist[[selected]], tn])

To create a brief summary grid for a core:

In[]:=

coreInfoSmall[ids_]:=Module[{rows=playerdata[Select[MemberQ[ids,#["Mem ID"]]&]], gender},gender=Lookup[Normal@Counts[rows[All,"Gender"]],{"Female","Male"},0];Grid[{{"f",Style[gender[[1]],Orange]},{"m",Style[gender[[2]],Green]},{"a",N@rows[Median,"age"]},{"p",N@rows[Mean,"pow"]}},Spacings0]]

To create a button for adding/removing a core:

In[]:=

coreButtons[coreids_]:=Dynamic[Button[Row[{#," ",coreInfoSmall[coreids[[#]]]}],moveCore[#,selected],AppearanceWhich[MemberQ[teamlist[[selected]],#],"Pressed",MemberQ[Flatten[teamlist],#],"Palette",True,"DialogBox"]],TrackedSymbols{teamlist,selected}]&/@Range[Length[coreids]]

And the full GUI:

In[]:=

makeGUI[graph_, coreids_]:=Panel@Grid[{{Grid[Partition[dynamicTeamGraphButtons[graph],UpTo[Ceiling[$numTeams/2]]]]},{coreButtons[coreids]}}]

With this, we have the GUI. Initially, the largest eight cores are each put into a team. On top, the GUI shows the current state of the teams with graphs and brief summaries of the important metrics. There’s a graph for each team along with the number of men and women, and then two statistics, the median age and mean power. The graphs and summaries are buttons that can be used to select a team from which to add or remove cores of players.

Beneath that is a row of buttons for the cores. Each button shows the same metrics as the team summaries. This makes it pretty easy to smartly match up teams with cores that will bring them closer to the league-wide average.

In[]:=

makeGUI[modifiedgraph,coreIDs]

Out[]=

I start by adding cores to teams to make sure each team has a captain and at least four women. For similar cores like 18 and 19—each of which have one woman, one man and no captains—I choose which core goes on which team, in order to even out the median age.

In[]:=

makeGUI[modifiedgraph,coreIDs]

Out[]=

Finally, I add the men to the teams so that each team has approximately the same number, while also trying to level the age and power values.

In[]:=

makeGUI[modifiedgraph,coreIDs]

Out[]=

Results

Now I’ve grouped all the players into teams! I reformat those lists from core IDs to player IDs.

The variable teamlist is a list of all the cores for each team.

In[]:=

teamlist

Out[]=

{{1,17},{2,27,16,29},{3,12},{4,18,28,15},{5,23,19,11},{6,25,24,13},{7,20,8,14},{10,30,9,21,22,26}}

I turn that into a list of player IDs for each team.

In[]:=

getTeam[tl_]:=Flatten[coreIDs[[tl]]]

In[]:=

teams=getTeam/@teamlist

Out[]=

{{3494,1684,2535,105,629,207,2318,2613,64,4018,62,645,4634,723,3549,3636,2523,2460,2728},{3547,3156,3993,4648,27,2851,3077,3098,4032,4565,4578,691,2065,3872,3253,4582,4625,4124,2712,3245},{3965,3966,4156,4639,3953,4117,4608,4638,2185,7,3780,4036,4560,42,11,4631,4630,4633,4641},{3951,71,4548,405,2492,1384,3814,2230,4567,3538,3999,4465,4553,4327,3489,2047,2380,2242},{2583,1934,3351,1931,2182,3424,598,4603,3554,2180,2945,4119,4593,4123,3971,3578,3558,3559,3912,2638},{2924,1893,1345,2550,2068,999,3502,1300,3417,1584,4568,3428,3967,1976,1716,2256,3922,1336},{3187,196,866,960,188,190,508,2502,565,4482,200,4597,3898,4017,3896,3897,2224,3779,3860,3778,4644},{4580,744,3622,4591,4572,3891,4640,2553,1967,3537,3179,3599,3933,3963,4629,126,435,4599}}

I always double-check that no one was missed and no one was mistakenly included by comparing the team lists with the original list of player IDs.

In[]:=

Complement[Sort[Flatten[teams]],Sort[ids]]

Out[]=

{}

In[]:=

Complement[Sort[ids],Sort[Flatten[teams]]]

Out[]=

{}

Analysis

For some basic sanity tests, I make a dataset for each team.

In[]:=

teamdatasets=Function[{core},playerdata[Select[MemberQ[core,#["Mem ID"]]&]]]/@teams;

Then I find the captains for each team. Team five is missing a captain, so someone will need to be volunteered.

In[]:=

Dataset[Association[{"Captain"->#[Select[#["mgr"]&]/*(StringRiffle[#,"; "]&),"Name"],Normal[#[Counts,"Gender"]]}]&/@teamdatasets]

Out[]=

Captain	Female	Male
Susan Moon; Henri Queuille	5	14
Julie Pietri; Zach Wood	6	14
Jacoby Green	4	15
Alban Curteis; Johnny Marcum	4	14
	5	15
Andrew Green	5	13
Ronald Martin	5	16
Justus Harris	5	13

Next, I compare age and each self-evaluation metric with box whisker charts. Team seven may have a minor athleticism deficit, but overall the parity is good.

In[]:=

makechart[param_]:=BoxWhiskerChart[(Labeled[#,Mean[DeleteMissing@#],Bottom]&[N@ToExpression[StringReplace[ToString[Normal[#[All,param]]],{"A""","E""","S"""}]]/.NullMissing[]])&/@teamdatasets,PlotLabelparam,ImageSizeLarge,ChartLabelsRange[6]]

In[]:=

makechart/@{"age","pow","ath","skl"}

Out[]=





See the Real (Fake) Names

Now that I’m happy with the teams, I can finally view the names without fear of biasing myself.

In[]:=

Framed[Subgraph[originalgraph,teams[[#]],VertexLabels$nameLabels,ImageSize500,PlotLabel"Team "<>ToString[#]]]&/@Range[$numTeams]

Out[]=





Wrapping Up with Export

When I’m done, I export the teams as CSV files and email them to the coordinator. Personally, I’d rather export them to cloud objects and send the links out. But some people love email attachments.

In[]:=

CreateDirectory[dir=FileNameJoin[{NotebookDirectory[],"slua2019/v7"}],CreateIntermediateDirectoriesTrue];dir

Out[]=

/Users/bobs/Documents/Bob/BobPersonal/slua2019/v7

In[]:=

files=With[{roster=teamdatasets[[#]]},Export[FileNameJoin[{dir,"team"<>ToString[#]<>".csv"}],roster]]&/@Range[$numTeams];zip=CreateArchive[dir]SendMail[<|"To""leaguecoordinator@example.com","Subject""Check these teams","Attachments"zip|>]

Out[]=

Success

✓

Message: Mail sent.

Recipient: leaguecoordinator@example.com



And that’s how the Ultimate teams are made step by step. Of course, this isn’t limited to building Ultimate teams; you can apply this method to help organize other groups of people with complicated systems or “baggage.” There are several steps—like sorting cores and importing and exporting data—where the Wolfram Language provides a convenient tool, and one step (splitting baggage chains) where the Wolfram Language turns an overwhelming problem into a simple task. What do you think, Mr. Bird?

In[]:=

ResourceFunction["BirdSay"][Column@{"That's cool!",First@WebImageSearch["Ultimate Frisbee","Thumbnails",MaxItems1]}]

Out[]=

That's cool!

BONUS: Creating Dummy Data

I needed to avoid sharing real names of the people I play Ultimate with for this blog. But Jon Doe 87 is not a very fun name. With just a few lines of code, I swapped the real names with notable people from the Wolfram Knowledgebase.

Dummy Player Data HTML

In[]:=

gendercounts=playerdata[Counts,"Gender"]

Out[]=

Female	39
Male	114

In[]:=

dummynamesf=ExportString[#,"HTMLFragment"]&/@EntityValueRandomEntityEntityClass"Person",

gender

"Female",gendercounts["Female"],"Name"

Out[]=

{Lea Davison,Lucy Hale,Nikki DeLoach,Helen Bray,Nadezhda Besfamilnaya,Hilda James,Doris Svedlund,Mary Buff,Ewa Klobukowska,Baba Jigida,Lucie Decosse,Bernadette Lafont,Sarah Lawson,Musarrat Nazir,Charice Pempengco,Wendy Rosen,Jill Haworth,Denise Joaquin,Bonnie Somerville,Jasmina Perasic,Kimiko Uehara,Madison Keys,Dinah Pfizenmaier,Cheuk Wan Chi,Heather Menzies,Cornelia Pieper,Olga Akopyan,Jacqueline Durran,Janice Hahn,Oona Hart,Yaeko Yamazaki,Jelena Dimitrijevi&cacute;,Aale Tynni,Sandra Leigh Saulsbury,MØ,Carmen Llywelyn,Katarina Johnson-Thompson,Marilyn L. Huff,Bibi Aisha}

In[]:=

dummynamesm=ExportString[#,"HTMLFragment"]&/@EntityValueRandomEntityEntityClass"Person",

gender

"Male",gendercounts["Male"],"Name"

Out[]=

{Steven Spenner,Jerauld Wright,Dillon Alexander,Paul Pressler,Tavion McCaskill,Ronald Morris,Germain Sommeiller,Herbert Atkins,David Edward Maust,Gregory Crewdson,Marcus Davenport,Don McEvoy,Klaus Barbie,Troy Brown,Jim Rice,Michael Aston,Xavier Dowtin,William Penn,Bob Fothergill,Constantin Silvestri,Harold Putnam,Trevor Richards,Pokotoa Sipeli,Scott Suggs,John Keenan,Mamed Khalidov,Roger Thomas Foley,Omar Gaither,King Kelly,Kelly Assinesi,Bill Butler,Lee Hunt,Julian Cecil Stanley,Walter B. Huffman,Consequences Creed,M. A. Jalil,Philippe Falardeau,Bryce Cosby,Stephen Friedman,Tory Stewart-Miller,Uzi Feinerman,John Vargas,Alec B. Francis,George Frederik Willem Borel,Roland Brown,Bill Butterfield, Jr.,Lee Hills,Georg Mohr,Dhonte Ford,Seb West,Jeff McCarty,David M. Jones,Maulana Fazlullah,Edward Kriewall,D'Aaron Davis,Lee Ferrell,Jeff Peck,Jan Zelezny,Scott Sunderland,Joe Moore,Joe Donnelly,Ronnie Prude,Paris Carter,Minyekyawswa,Walter Jost,Burnet Rhett Maybank,Zachary Slade,Glen Coffield,Helmut Sohmen,Red Mack,Archduke Friedrich of Austria,Charlie Newman,Haim Watzman,Jayme Odgers,Keith Askins,Stan Hollmig,John Derbyshire,Patrick Gordon,Curtis Holbrook,Darren Woodford,Michael Rennie,Heinrich Harrer,John Ekels,Mehdi Nafti,James Scannell,F. O. Matthiessen,Justus Woods,Ian Michael Smith,James Rockefeller,Blain Padgett,Devin Williams,George Frederick Cameron,John Hathorn,Daniel Kiss,Danger Mouse,Buddy Hassett,George Kramer,John Thomas Serres,Basil Harwood,Mario Lang,Alec Gibson,Jim Riley,Peter Black,Craig Cotton,Sten Pettersson,Henry Ford,Ben McGee,Henry Roussel,Lucian,Rob Affuso,Herb Nelson,Ryan Posey,Tom McCamus,Glenn Foley}

In[]:=

html=Import[$urls[[1]],"String"];

In[]:=

rows=StringCases[html,"<tr"~~Shortest[__]~~"</tr>"];

In[]:=

frows=Select[rows,StringContainsQ[#,"Female"]&];

In[]:=

mrows=Most@Complement[rows,frows];

In[]:=

fixRow[r_,new_]:=StringRiffle[StringSplit[StringReplace[r,StringSplit[r,"</td>"][[4]]->"\n\t\t<td align=\"left\" nowrap><b>"<>new<>"</b>\n\t\t\t\t\t"],"</td>"],"</td>"]

In[]:=

rulesf=MapThread[#1->fixRow[#1,#2]&,{frows,dummynamesf}];

In[]:=

rulesm=MapThread[#1->fixRow[#1,#2]&,{mrows,dummynamesm}];

In[]:=

rules=Join[rulesf,rulesm,{rows[[1]]StringRiffle[StringSplit[rows[[1]],"</th>"],"</th>"]}];

In[]:=

dummyhtml=StringReplace[html,Join[rulesf,rulesm,{rows[[1]]StringRiffle[StringSplit[rows[[1]],"</th>"],"</th>"]}]];

In[]:=

Export["dummy.html",dummyhtml,"String"]//SystemOpen

In[]:=

CopyFile["dummy.html",CloudObject["Ultimate2019DummyPlayers.html",Permissions"Public"]]

Out[]=

CloudObject[

https://www.wolframcloud.com/obj/bobs/Ultimate2019DummyPlayers.html

]

Cite this as: Bob Sandheinrich, "The Ultimate Team Generator with the Wolfram Language" from the Notebook Archive (2019), https://notebookarchive.org/2019-08-0ymunme