House hunting in the cloud

Let us continue the tradition of following a low-level language coding post with really high-level. This time, with a cloud to boot.

Anyone who was apartment and house hunting knows that it is time consuming and hard to go through individual listings. Extracting trends from a large number of them can be very time-consuming and involving a lot of manual input.

It would be really helpful to have a took that would extract the features you need from a listing feed, and visualize it in your preferred way, like so:

We can actually do this with a little bit of coding entirely in Wolfram Cloud. Let's get started with a sample Toronto MLS listing selection (the kind you will be receiving from a real estate agent), looking like so (sorry for a tall image).

So the task is (1) to web-scrape the listing web page for information, and (2) to visualize it in human digestible form.

Using this nice Wolfram Language scraping guide, we can get started by simply grabbing the table data in one line, like so:

url = "http://v3.torontomls.net/Live/Pages/Public/Link.aspx?Key=...&App=TREB";
structured = Import[url,"Data"];
mlstable = structured[[1,2]];
addresses = Transpose[mlstable][[2]];
rawprices = Transpose[mlstable][[4]];
prices = ToExpression[StringReplace[#,{"$"->"",","->""}]]&/@rawprices;

Now we have the list of street addresses and prices. To geo-locate the addresses, the easiest way is to complete each address with city and country info, ans then use Interpreter:

locations = Map[Interpreter["StreetAddress"][#<>", Mississauga ON Canada"]&, addresses];

We can then convert the list of prices into a list of colored pins where color is determined by the house price, using a slightly modified example from GeoMarker documentation:

pin[color_]:= Graphics[GraphicsGroup[{FaceForm[color],EdgeForm[Black],
   FilledCurve[{{Line[Join[{{0, 0}}, ({Cos[#1], 3 + Sin[#1]} &) /@
   Range[-((2 Pi)/20), Pi + (2 Pi)/20, Pi/20], {{0, 0}}]]}, {Line[(0.5 {Cos[#1], 6 + Sin[#1]} &) /@
   Range[0, 2 Pi, Pi/20]]}}]}]]
rcfun[sc_] :=Blend[{{0,Green},{0.5,RGBColor[0.75,0.75,0]},{1,Red}},sc]
pins = Map[pin[rcfun[(#-900000)/(1300000-900000)]]&,prices];

It only remains to convert the list of geographical coordinates and pins to GeoMarker and filter out failed address lookups (as well as missed lookups, defined as those more than say 10 miles away from the arbitrarily chosen city center), like so

markertable = MapThread[GeoMarker[#1,#2]&,{locations,pins}];
home = Interpreter["StreetAddress"]["Square One, Mississauga ON Canada"];
goodmarkers = Select[markertable,(!FailureQ[#[[1]]] && GeoDistance[#[[1]],home][[1]]<10)&];

In my example, 94 markers out of 99 remain as "good". Then, we simply plot the markers on a map using GeoGraphics:

gp = GeoGraphics[{"Mississauga",Append[goodmarkers,GeoMarker[home,pin[White]]]}];
gins=DensityPlot[(x*1000-900000)/(1300000-900000),{y,0,1},{x,900,1300},ColorFunction->rcfun,AspectRatio->5,FrameTicks->{None,Automatic},Background->RGBColor[1,1,1,0.5],FrameStyle->Directive[Thick],LabelStyle->Normal];
Show[gp,Epilog->Inset[gins,Scaled[{1,0}],Scaled[{1,0}],0.028]]

In the second example let us color code the markers using price per square foot. Note that the square footage of the houses is not in the table, so we need to parse individual listings. So we need to do a more complicated web scraping:

url = "real_estate.html"; xml = Import[url,"XMLObject"];
formitems=Cases[xml,XMLElement["span",{"class"->"formitem formfield"},x_]->x,Infinity];
sqfeet=ToExpression[Last[StringSplit[#,"-"]]]&/@((If[#[[3]]=={},"0-0",#[[3,1]]])&/@Extract[formitems,(#+{0,1})&/@Position[formitems,XMLElement["label",{},{"Apx Sqft:"}]]] )

Note several things about this code:

• The specific criteria to supply to Cases have been determined by inspecting the page code in the browser; in this case all the information bearing fields conveniently are <span> tags with classes formitem formfield. Your particular case will be different.
• In the last line, Extract basically retrieves "every element following a label saying Apx Sqft:". Again your case will be different, and I admit that this is not the only way to get to the right info.
• Local HTML file is used instead of a live URL. This is a trick dome to work around asynchronous deferred loading of listings on Toronto MSL website; if live URL were used, the scraper would only retrieve some 25 listings. The HTML file is obtaied by loading the MLS link, scrolling all the way down (not too fat so that all listings have a chance to load), then saving the webpage as a complete package and loading its HTML file into Wolfram Cloud (or creating a text file in the cloud and copy-pasting, or hosting it locally and making it accessible to Wolfram Cloud)
• The last portion, involving Last[StringSplit[...]] is needed to convert approximate designations like "1500-2000" into a number 2000.

After this, the code is familiar, except that marker filtering should now include filtering out the listings without square feet information:

pricesperfoot = Quiet[prices/cfeet];
score=Quiet[(pricesperfoot-250)/(800-250)];
scorepins=Map[pin[rcfun[#]]&,score];
smarkertable = MapThread[GeoMarker[#1,#2]&,{locations,scorepins}];
sgoodmarkers=Select[smarkertable,(!FailureQ[#[[1]]] && GeoDistance[#[[1]],home][[1]]<10 
                    && NumberQ[#[[2,1,1,1,-1,-1]]])&];
gs=GeoGraphics[{"Mississauga",Append[sgoodmarkers,GeoMarker[home,pin[White]]]}];
Show[gs,Epilog->Inset[ginss,Scaled[{1,0}],Scaled[{1,0}],0.028]]

Here's the final result:

This is only an example I spent about an hour coding, another 1-2 polishing and another 1-2 hours writing about. Your mileage may vary. By the same token you can easily visualize houses according to any score you compute (such as "price per score determined by adding the number of bedrooms and half the number of washrooms"). You can also add multidimensional visualization, where a pin's size, or border color, or shape, or all of these, would convey different information. You can use geo-location and scrape some other website to score neighborhoods and show the "best bang for the buck" according to that score. You can build a linear regression machine-learning house pricing service. If you are dragged into the boredom of house hunting, there are always ways to make some colorful fun out of it :) .

Laurel / Yanny Hands-On

Ever since the Laurel/Yanny auditory illusion went viral, I had a suspicion that we are dealing with a bifurcation-type illusion similar to the "figure or ground" type:

That guess seemed correct with the publishing of a NY Times article where you can "move a slider" to augment the clip in either direction, causing either "Laurel" or "Yanny" to be more pronounced.

I admit that this article is quite revealing and educating (it taught me how I can tweak my brain into hearing one or the other). But moving a slider still seems rather artificial. For all I know they could have been cheating, actually having two separate recordings and the slider mixing them in different proportions.

Can we prove this wasn't cheating? Hands on?

Yes we can.

Some snooping around reveals that here is a working version of the original recording:
https://ia802800.us.archive.org/28/items/YannyVsLaurelVideoWhichNameDoYouHear-Audio/Yanny%20vs%20Laurel%20video%20which%20name%20do%20you%20hear%20%E2%80%93%20audio.mp3

Let's go to Wolfram Cloud Computing and run this simple program:

url="(the url above)"
audio=AudioTrim[Audio[url],{0,4}]
CloudExport[AudioPitchShift[audio,1.1],"wav"] (*Laurel*)
CloudExport[AudioPitchShift[audio,0.85],"wav"] (*Yanny*)

We see that at the heart of it is AudioPitchShift which simply shifts the pitch of the recording by the desired amount. Looks like lower frequencies emphasize "Yanny" while higher frequencies bring out "Laurel", in agreement with the above mentioned Wikipedia article.

My conjecture, based on the observation that "Laurel" is lower-frequency than "Yanny", is that we tend to hear whatever is closer to the maximum frequency sensitivity of our ears, so whoever initially hears "Yanny" likely has an ear for higher-pitched tunes than the "Laurel" guy.

It could have been a bit easier if Wolfram Cloud could actually play audio from within the interface without resorting to CloudExport. Still, it opens nearly endless possibilities for experiments. Enjoy!

Card tricks brute forced

(Now going from lowest-level to highest-level coding)

When I was in middle school, we used a standard 36-card playing deck (from 6 onwards) to play a bunch of games. We also used this deck to do some "loves me, loves me not" type fortune telling where "loves me" was indicated by, essentially, an occurrence of two aces in a row somewhere in the deck.

Much later on I got curious about how likely that outcome was. A short back of the envelope calculation gives

P = [P(A1)*P(A2|A1)]*N 
where 
P(A1) = probability of "there is an ace at position 1 in the deck", 1/9
P(A2|A1) = probability of "there is an ace  at position 2 n the deck if there already is an ace at position 1", 3/35 (3 aces left, out of 35 cards possible)
N = 35 -- number of different positions in the deck where two consecutive aces can occur.

Hence

P = [(1/9)*(3/35)]*35 = 1/3

This looks too high, at first sight. 
So let's write a simple brute-force proof in Wolfram Language (ex-Mathematica):

cards = "6789TJQKA";
adeck = Characters[cards<>cards<>cards<>cards];
testdeck[deck_List] := Length[StringPosition[StringJoin@@ToString/@deck,"AA"]]>0;
(*Monte-Carlo*)
n=100000;For[c=0;i=0,i<n,i++,(thedeck=RandomSample[adeck];If[testdeck[thedeck],c++])]
approx=N[c/n]

It is more or less obvious what the code does: it just tests a large number n of permutations on a deck (using RandomSample[])and then testing whether the resulting deck has at least two aces in a row (searching for "AA" in a deck converted to a string) and counting the number of decks in which this is found.

You can run the code in Wolfram Cloud and make sure the answer is indeed quite close to 0.3

(In hindsight, is it so strange, really? A "loves me, loves me not" trick will only survive among kids if it has a significantly non-negligible chance of a favorable outcome. And I do believe this is how most fortune telling works.)

Naturally you can modify the code very simply to include other card tricks.
For example, you can set cards="23456789TJQKA" for a standard 52-card deck; additionally you can append <>"XX" to cards<>cards<>cards<>cards to include jokers (or <>"AA" if you want them to be wild and count as aces).
Or you can change the testing function to test for any card sequence (like "AK" or "6789"), or indeed modify the criterion to any degree of complexity.

Finally, if you want to differentiate the suits of cards, we will need a slightly more complicated code:

cards = "6789TJQKA"; suits = "SHDC";
adeck = Outer[StringJoin, cards//Characters, suits//Characters]//Flatten;
testdeck[deck_List] := Length[StringPosition[StringJoin@@(First[Characters[#]]&)/@deck,"AA"]]>0;

Isn't it just beautiful how you can combine Map (/@) and Apply (@@) along with Mathematica's pure functions to create tests on lists without unnecessary boilerplate like loops? (And we can verify that making all aces distinct does not change the probability of two of them following each other.)

Finally, I initially planned to do a rigorous (rather than Monte-Carlo) test using Permutations[adesk], but it turns out that Mathematica won't have lists with "more than machine integer" elements. Sad but would probably work (and chances are, will be much faster than Monte-Carlo) with shorter decks.