drjjmc/mmaGolf.md

## mmaGolf.md

      
    Raw
  

              mmaGolf.md
            
          
    Table

Let's first look at the Table:

    n = Table[
       Normalize[
        Mean /@ Transpose@
          normals[[
           First@Transpose@Position[elements, boundary[[i]]]]]], {i, 1, Length@boundary}];
We see that it's just iterating over the boundary values (the only place the index i appears is to access elements of boundary).  So let's just Map over boundary:

    nn = Map[Normalize[
        Mean /@ Transpose@
          normals[[First@Transpose@Position[elements, #]]]] &,
      boundary];    
    n === nn

True

The hash sign (#) is a stand in for each element of the list boundary (equivalent to the boundary[[i]] in the for loop).  The ampersand & is required to trigger the replacement #->element of boundary whenever you have an explicit #.
We can use the infix form of Map[a,b]=a /@ b to make things a little shorter:

    nnn = Normalize[
        Mean /@ Transpose@
          normals[[First@Transpose@Position[elements, #]]]] & /@ boundary; 
    n === nnn

True

Now lets see what First@Transpose@Position[elements,#]] is doing.  It's getting a list of all the first elements of the list of lists  Position[elements,#].  Well we can shorten this by just Mapping first over the list  Position[elements,#]:

    nnnn = Normalize[
        Mean /@ Transpose@
          normals[[ Map[First, Position[elements, #]]]]] & /@ boundary; 
    n === nnnn

True

Of course we can shorten this Map by using the infix.  Note here we don't need an ampersand (&) on the inside map because we don't use an explicit #.

    n5 = Normalize[
        Mean /@ Transpose@normals[[ First /@ Position[elements, #]]]] & /@ boundary; 
    n === n5

True

(This is the same as First[#]&/@Position[elements,#], but why waste the characters -- we don't need the placeholder # since First only takes one argument, so Mathematica is clever enough to apply it in the map without giving it the variable placeholder.)
We're almost done.  Let's think about Mean/@Transpose@normals is doing.  normals is a list of 2 element lists.  You want to average all the first values, and all the second values.   The thing is Mean auto-threads over lists: i.e. it will average lists.  So we can just do:

    n6 = Normalize[Mean[normals[[ First /@ Position[elements, #]]]]] & /@ boundary; 
    n === n6

True

But this is a needless introduction of two square brackets when we can use one @ sign.

    n7 = Normalize[Mean@normals[[ First /@ Position[elements, #]]]] & /@ boundary; 
    n === n7

True

We can get rid of one more set of brackets w/ the Normalize[] to land on:

    n8 = Normalize@Mean@normals[[First /@ Position[elements, #]]] & /@ boundary;
    n8 === n

True

For loop.

    For[i = 1, i <= Length@n, i++, 
     v = First@Drop[Nearest[interior, boundary[[i]], 2], 1] - 
       boundary[[i]];
     If[v.n[[i]] < 0, n[[i]] = -n[[i]]];]
Ok, so this only does something for special bad values of n. Let's first get all those special i's then do something cool to n[[]] all at once.

    nn = n8;

    badGuys = {}; For[i = 1, i <= Length@nn, i++, 
     v = First@Drop[Nearest[interior, boundary[[i]], 2], 1] - 
       boundary[[i]];
     If[v.nn[[i]] < 0, AppendTo[badGuys, i]];];
    nn[[badGuys]] *= -1;
    nn === n

True

So we see that we flip all the bad guys all at once using list[[badGuys]]*=-1;
Ok but this For loop is a laborious way to select things from the set Range[Length[n]] that satisfy a certain condition.  We will instead use Select.

    nnn = n8;

    badGuys = 
      Select[Range@
        Length@nnn, (v = 
          First@Drop[Nearest[interior, boundary[[#]], 2], 1] - 
           boundary[[#]];
         v.nnn[[#]] < 0) &];
    nnn[[badGuys]] *= -1;
    nnn === n

True

Note Select is like Map,  # is the placeholder for the element.  It replaces everywhere we had i in the For loop. Note now we need an ampersand to trigger the replacement since we're using #.
Now let's finish golf-ing this:   First@Drop[list,1] === list[[2]].  So

    nnnn = n8;

    badGuys = 
      Select[Range@
        Length@nnnn, (v = 
          Nearest[interior, boundary[[#]], 2][[2]] - boundary[[#]];
         v.nnnn[[#]] < 0) &];
    nnnn[[badGuys]] *= -1;
    nnnn === n

True

Note, see how boundary[#] appears twice?  We can save characters by introducing an anonymous function:   i.e.

(f[a]+g[a]) === (f[#]+g[#])&[a]  (see how the hash # substitutes for a, also notice the manditory ampersand
to trigger the hash replace?):

    n5 = n8;
    
    badGuys = 
      Select[Range@
        Length@n5, (v = (Nearest[interior, #, 2][[2]] - #) &[
           boundary[[#]]];
         v.n5[[#]] < 0) &];
    n5[[badGuys]] *= -1;
    n5 === n

True

We don't really need to define v, can just use it:

    n6 = n8;

    badGuys = 
      Select[Range@
        Length@n6, (Nearest[interior, #, 2][[2]] - #) &[
           boundary[[#]]].n6[[#]] < 0 &];
    n6[[badGuys]] *= -1;
    n6 === n

True

Similarly we don't need to define badGuys, just use it:

    n7 = n8;

    n7[[ Select[
        Range@Length@
          n7, (Nearest[interior, #, 2][[2]] - #) &[
            boundary[[#]]].n7[[#]] < 0 &]]] *= -1;
    n7 === n

True