Transpose Error

Question

I have this code:

pic = ContourPlot[
  b (2 - 7 y + 8 y^2 - 4 y^3) + 
    2 y (1 - 4 y^(b/2) + 4 y - 4 y^2 - 2 y^((4 + b)/2) + 
       8 y^(1 + b/2)) == 0, {y, 0, 1}, {b, 6, 8}, FrameLabel -> {y, b}]
{yi, bi} = Transpose[pic[[1, 1]]]
ymax = MaximalBy[Transpose[{yi, bi}], Last][[1, 1]]

yb = Interpolation[Select[Transpose[{bi, yi}], #[[2]] >= ymax &]]
Plot[-b Log[yb[b]], {b, Min[bi], Max[bi]}, AxesLabel -> {b, u}]

I get an error as below: Transpose::nmtx: The first two levels of {yi,bi} cannot be transposed. Can anybody please look at the code and let me know why its giving such prompt?

Answer 1

The OP's fixed code produces this final plot, which has some glitches:

Here's an improvement in the interpolation:

f[y_, b_] := b (2 - 7 y + 8 y^2 - 4 y^3) + 
   2 y (1 - 4 y^(b/2) + 4 y - 4 y^2 - 2 y^((4 + b)/2) + 8 y^(1 + b/2));
pic = ContourPlot[f[y, b] == 0, {y, 0, 1}, {b, 6, 8}, FrameLabel -> {y, b}];
{yi, bi} = Transpose[pic[[1, 1, 1]]];  (* <-- this where the OP made a mistake *)
ymax = MaximalBy[Transpose[{yi, bi}], Last][[1, 1]];
dyi = -Derivative[0, 1][f][yi, bi]/Derivative[1, 0][f][yi, bi];

yb = Interpolation[
   Select[Transpose[{List /@ bi, yi, dyi}] /. ComplexInfinity -> -20.,
    #[[2]] >= ymax &]];
Plot[-b Log[yb[b]], {b, Min[bi], Max[bi]}, AxesLabel -> {b, u}]

Power::infy: Infinite expression 1/0. encountered.

The derivative at b == 0 is infinite, which cannot be approximated by polynomial interpolation. There are two choices, get rid of the derivative value with ComplexInfinity -> Nothing or set it equal to an appropriately large value such as ComplexInfinity -> -20. (which is actually better than Nothing). For this particular problem the slope should be negative. Both work. Beware: if you set the slope too large, for instance -1000., you get a large glitch near b == 0, because, again, there's only so much you can do with a cubic polynomial interpolant. (Actually, somewhere around -20. is about the best you can do in this case.)