Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

After participating in Google Code Jam 2012 Round 2, it occurred to me that the Mountain View problem boiled down to solving a set of linear inequalities, which could be done in Mathematica. I've only tinkered with Mathematica programming before, but I tried it out to see how hard it was for this problem. I got it to work (for the "small" input set only) with a lot of effort. I felt like I must be doing some things the hard way and would like feedback on the proper Mathematica idioms for file I/O and expression building (and anything else).

You may have to read the problem description (link above), but the basics are:

  • You read test cases from an input file, C.in.
  • You write answers to an output file, C.out.
  • Each input case contains a number of mountains and a constraint number for each mountain.
  • Each output line contains a list of possible mountain heights or the word "Impossible"

My program follows.

During development, I send output to stdout. debug toggles that. I put it early because I thought I might use it for Print statements.

debug = False;

This function solves a single case, including reading input and writing output.

solveCase[in_, out_, cn_] := 
  Module[{nm, im, highest, vars, constraints, i, j, k, rhs, lhs, yk, 
    yi, yj, answer},

Read the input: the number of mountains and the apparent highest mountain that can be seen from each of the first nm-1 mountains.

    nm = Read[in, Number];
    highest = Array[0, nm - 1];
    For[im = 1, im <= nm - 1, im++, 
     highest[[im]] = Read[in, Number];
     ];

Start setting up expressions to pass later to FindInstance. Is there a way to solve for a vector of variables without giving each one a separate name? Not finding any, I create the variables as h1, h2, ... and the initial constraints as h1 >= 0, h2 >= 0, ...

    vars = 
     Function[x, ToExpression["h" <> ToString[x]]] /@ Range[nm];
    constraints = 
     Function[x, ToExpression["h" <> ToString[x]] >= 0] /@ Range[nm];

Convert the highest info into a list of constraints. When mountain i sees mountain k as the highest, it means the slope of the line between their peaks is above the line for each j between i and k and above or at the line for each j after k.

    For[i = 1, i <= nm - 1, i++,
     k = highest[[i]];
     For[j = i + 1, j <= nm, j++,
      If[j == k, Continue[]];

Build constraint, (hk - hi) * (j - i) GT/GE (hj - hi) * (k - i). This part seems especially clumsy. I ended up resorting to strings, but there must be a way to do it at the expression level.

      yk  = "h" <> ToString[k];
      yi = "h" <> ToString[i];
      yj = "h" <> ToString[j];
      lhs = ToExpression["(" <> yk <> " - " <> yi <> ") * " <> ToString[j - i]];
      rhs = ToExpression["(" <> yj <> " - " <> yi <> ") * " <> ToString[k - i]];
      If[i < j, AppendTo[constraints, Greater[lhs, rhs]], 
       AppendTo[constraints, GreaterEqual[lhs, rhs]]];
      ];
     ];

The real work:

    answer = FindInstance[constraints, vars, Integers];

Write the output as Case #N: h1 h2 ....

    WriteString[out, "Case #", cn, ": "];
    If[Length[answer] > 0,
     answer = answer[[1]][[ All, 2]];
     For[i = 1, i <= nm , i++, WriteString[out,  answer[[i]]]; 
      If[i < nm, WriteString[out, " "], WriteString[out, "\n"]]],
     WriteString[out, "Impossible\n"]];
    ;
   ];

The "main" program. Set up in and out and cycle through the cases. I'm guessing the entire program should go in a Module with local-only variables.

in = OpenRead["~/Documents/math/C.in"];
If[debug, out = OutputStream["stdout", 1], 
  out = OpenWrite["~/Documents/math/C.out"]];
ncases = Read[in, Number];
For[ic = 1, ic <= ncases, ic++, solveCase[in, out, ic]];
Close[in];
If[! debug, Close[out]];

This method takes forever for the 1000+ mountain case, so if there is a better way than FindInstance, I'd like to hear about that, too. Or maybe the code needs to take into account higher level constraints rather than solving the most general form of the problem.

Note: After seeing no use of Mathematica (Code Jam Language Stats) in previous contests, I realized Mathematica is not allowed because there is no free version, so this is even more of an academic exercise than I intended.

share|improve this question

2 Answers 2

up vote 11 down vote accepted

Preamble

After seeing no use of Mathematica (Code Jam Language Stats) in previous contests, I realized Mathematica is not allowed because there is no free version

This is only to some point correct. Matlab is allowed too and is of course not free and very expensive. I was helping a friend of mine in round 2 and we weren't even close to good. Partly because we are scientists and we love to analyse stuff. This is kind of the opposite of hacking very fast and if you look at the solutions of the others, you may notice that they mainly consist of spaghetti-like for/do/while battles. The other big part was, that I thought I cannot use Mathematica which eliminates the language where I'm maybe able to hack things faster than in other languages.

Surely, the rules say "only free languages" but they also note:

Google reserves the right to make further exceptions on a case-by-case basis at its sole discretion.

With Matlab being allowed I think it is worth a try to just solve and ask later. Since I've seen this too late, we were using Haskell.

Note: As Szabolcs points out in the comment the FAQ state that Mathematica is explicitly not allowed. We should really talk to the Google-guys.

Solution

Something like FindInstance is probably a very bad idea because it maybe slow for very large things and you can count on that Google always gives you a hard time with the large data-set.

From what I have seen so far in all the contest problems I have the feeling, that an algorithmic/iterative way is often better than the implementation of a strong analytic solution. I've seen similar behavior in a problem which was about judges and points in a game-show. There we had solved the underlying mathematical problem but we struggled with one boundary condition. A simple numeric implementation would have led to a fast solution which would have worked for the small and large data-set.

Therefore, I show here an iterative method which jumps from peaks to peaks and assigns heights increasing with constant slope. If you are at the end, you go on with the next unassigned mountain and assign heights in between two already assigned mountains. You have to increase the slope to not break the validity.

The function gets the values {{c},{v1,v2,...}} from the input where c is the number of peaks and vn is the mountain you see.

 CalculateHeights[{{count_}, viewsIn : {_Integer ..}}] := Module[{
   heights, rightHighestPeak, ptr = 1, curheight = 10^9,
   slope = 0, startPeak = 1, views, n = Length[viewsIn] + 1},   
  If[count =!= n, Return["Impossible"]];
  rightHighestPeak = n;
  views = Append[viewsIn, n];
  heights = ConstantArray[0, n];
  While[True,

   (* Check whether someone tries to fuck with us *) 
   If[ptr < n && views[[ptr]] <= ptr || views[[ptr]] > n || 
     views[[ptr]] > rightHighestPeak,
    Return["Impossible"]];

   If[heights[[ptr]] === 0,
    heights[[ptr]] = curheight;
    curheight += slope*(views[[ptr]] - ptr);
    ptr = views[[ptr]],
    ptr = n
    ];

   If[views[ptr] === n || heights[[ptr]] =!= 0,
    (* Find next unassigned mountain *)

    While[heights[[startPeak]] =!= 0 && startPeak =!= n,
     startPeak++;
     ];

    (* Check if we are finished *)
    If[startPeak === n, Return[heights]];

    (* Calculate the new slope and the starting hight *)        
    Block[{leftHighestPeakHigh, rightHighestPeakHigh},
     ptr = startPeak;
     rightHighestPeak = views[[ptr - 1]];
     leftHighestPeakHigh = heights[[ptr - 1]];
     rightHighestPeakHigh = heights[[views[[ptr - 1]]]];
     slope = (rightHighestPeakHigh - 
          leftHighestPeakHigh)/(views[[ptr - 1]] - (ptr - 1)) + 1;
     curheight = 
      rightHighestPeakHigh - slope*(views[[ptr - 1]] - ptr)
     ]]]]

Some help functions for formatting, importing and exporting and then you can calculate the whole large data-set:

ImportData[url_] :=
 Partition[Rest@Import[url, "Table"], 2]

FormatOutput[result : {_Integer ..}] := 
  StringJoin[Riffle[ToString /@ result, " "]];
FormatOutput[arg__] := arg;

RunProblemSet[in_String, out_String] :=
 Export[out,
  MapIndexed[
   "Case #" <> ToString[#2[[1]]] <> ": " <>

     FormatOutput[CalculateHeights[#1]] &, ImportData[in]],
  "Table"]

RunProblemSet["tmp/C-large-practice.in", "tmp/C-large-practice.out"]

And finally you can send the output back to the Google-guys and check whether you did a good job

enter image description here

Removing ToExpression from your code

Basically there is absolutely no need for the ToExpression calls you used. The only thing you need is a unique set of variables you can use. You don't even have to bother how they are called, because you never see them. Therefore, use Unique to create as many variables as mountains and if you need to build expressions, you just reference to the variables in your list. With this you can just write down your constraints like (yk - yi)*(j - i) > (yj - yi)*(k - i). Here is your solver

CalculateHeights[views : {_Integer ..}] := Module[
  {nm = Length[views] + 1, vars, constraints, result},
  vars = Table[Unique[], {nm}];
  constraints = Thread[vars >= 0];
  constraints = Join[constraints, Flatten[Table[
      With[{k = views[[i]]},
       If[j === k, {},
        Block[{yk = vars[[k]], yi = vars[[i]], yj = vars[[j]]},
         (yk - yi)*(j - i) > (yj - yi)*(k - i)]]],
      {i, 1, nm - 1}, {j, i + 1, nm}]
     ]
    ];
  result = FindInstance[constraints, vars, Integers];
  If[result === {},
   "Impossible",
   vars /. First[result]
   ]
  ]

CalculateHeights[{5, 5, 5, 5}]

(* Out[36]= {1, 0, 0, 1, 4} *)
share|improve this answer
    
Thank you. Your solution is similar to my Java one, but I was curious about a more general technique. I guess the general solution is not as efficient as I thought it might be. Excellent to learn a proper way to do the I/O. I'm still curious about a better way to create expressions programmatically that doesn't involve ToExpression[string]. BTW, Matlab is allowed because Octave is a free clone. –  xan Jun 4 '12 at 13:12
    
@xan, please see my update. I didn't say (or mean) that a general approach is not better. I just claimed, that I'm often unable to find it in the shortness of time and when you look over the code of the winners, you see they often succeed with less than the proper analytic method. –  halirutan Jun 4 '12 at 14:11
2  
@xan, but Octave is not Matlab and has surely not all its computational strength. So if I implement a free Mathematica clone implementing a very small subset of its functionality (like Identity[])... you see where this leads. Maybe I just don't want to give up the hope that I can use Mathematica next time ;-) –  halirutan Jun 4 '12 at 14:14
    
There are "clones" that implement a big subset of the low level functionality of Mathematica, the easiest to try being mathics.net But given the size of the language and the guaranteed-to-be there high level symbolic processing tools, such as Integrate, it is practically impossible to create a true replacement which will actually be able to run most Mathematica programs. –  Szabolcs Jun 4 '12 at 14:19
2  
They explicitly forbid Mathematica, and they say MATLAB is allowed because of the free Octave. I wonder if they actually run the programs on Octave or the real MATLAB ... –  Szabolcs Jun 4 '12 at 14:31

[Not a full answer but too much for a comment.]

I think the constraints may be set up as follows.

eps = 1/100;
constraints[i_, j_, n_, x_] := 
 Table[(x[k] - x[i])/(k - i) <= (x[j] - x[i])/(j - i) - eps, {k, 
   Join[Range[i + 1, j - 1], Range[j + 1, n]]}]

Here is an example. I arbitrarily fix the first height to be 1. I also fix the scond to be 2. At worst one might have to retry with second equal to first and strictly less than first.

input = {10, {6, 5, 4, 5, 6, 7, 8, 9, 10}};
n = input[[1]];
vars = Array[x, n];
maxlist = MapIndexed[{#2[[1]], #1} &, input[[2]]];
allconstraints = 
  Join[{x[1] == 1, x[2] == 2}, 
   Flatten[Map[constraints[#[[1]], #[[2]], n, x] &, maxlist]]];
soln = FindInstance[allconstraints, vars]

{{x[1] -> 1, x[2] -> 2, x[3] -> 33/10, x[4] -> 47/10, x[5] -> 152/25, 
  x[6] -> 37/5, x[7] -> 431/50, x[8] -> 491/50, x[9] -> 11, 
  x[10] -> 304/25}}
share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.