8
$\begingroup$

I have this data

data = Table[{x, Sin[5 x], Tanh[3 x]}, {x, -1, 1, 0.01}];

which I plot as follows

colorbar[reg_] := Blend[{Blue, Black, Red}, Rescale[reg, {-1, 1}]]
ListLinePlot[data[[All, 1 ;; 2]],ColorFunction ->Function[{x, y}, 
   colorbar[data[[Position[data[[All, 1]], 
        Nearest[data[[All, 1]], x][[1]]][[1, 1]], 3]]]], 
 ImageSize -> 200, AspectRatio -> 0.6, ColorFunctionScaling -> False, 
 PlotStyle -> {Directive[Thickness[0.02], CapForm["Butt"]]}, 
 Axes -> False, Frame -> True, PlotRange -> {-1, 1}]  

enter image description here

the curve has the Thickness[0.02], my question is how can I assign a Thickness[0.005] for the black part of the curve and Thickness[0.02] for other colors?

$\endgroup$
3
  • $\begingroup$ Please learn how to propose the MINIMUM question. Do you need all those curves? Of course not. A single sine curve would suffice. You'll get more help that way. $\endgroup$ – David G. Stork May 16 at 16:22
  • 1
    $\begingroup$ @DavidG.Stork, thanks! modified accordingly. $\endgroup$ – valar morghulis May 16 at 17:16
  • 2
    $\begingroup$ related/possible duplicate: Vary the thickness of a plotted function $\endgroup$ – kglr May 16 at 23:28
6
$\begingroup$
ClearAll[variableWidthCurve, widthF, cF, crv]
variableWidthCurve[curve_, wf_][x_, u_] := curve[x] +
   (1 - 2 u) wf[x]/2 Cross@Normalize[curve'[x]];

widthF[func_, range_: {-1, 1}, minmaxthickness_: {.01, .1}][x_] := 
  Rescale[func[x], range, minmaxthickness];

cF = Blend[{Blue, Black, Red}, Rescale[Tanh[3 #], {-1, 1}]] &;

crv[x_] := {x, Sin[5 x]}

ParametricPlot[variableWidthCurve[crv, widthF[Tanh[3 #] &]][x, u], 
 {x, -1, 1}, {u, 0, 1},
 ColorFunction -> cF, ImageSize -> 400, AspectRatio -> 0.6, 
 ColorFunctionScaling -> False, BoundaryStyle -> None, Axes -> False]

enter image description here

Use widthF[Abs[#] &, {0, 1}, {0.01, .1}] to get:

enter image description here

$\endgroup$
6
$\begingroup$

There is probably a better solution, but here is a brute force approach.

data=Table[{x,Sin[5 x],Tanh[3 x]},{x,-1,1,0.01}];
colorbar[reg_]:=Blend[{Blue,Black,Red},Rescale[reg,{-1,1}]]

Divide the data into 50 segments, overlapping by 1 point:

segments=50;
data2=Partition[data[[All,1;;2]],segments,1];

Define widths based on the Norm of the RGB value at the middle x-value of each segment:

width[x_]:=Directive[Thickness[Norm[Cases[InputForm[colorbar[x]],RGBColor[v___]:>v]]/30]]
widths=Table[width[s[[Round[segments/2],1]]],{s,data2}];

ListLinePlot[data2,ColorFunction->Function[{x},colorbar[x]],ImageSize->500,AspectRatio->0.6,ColorFunctionScaling->False,PlotStyle->widths,Axes->False,Frame->True,PlotRange->{-1,1}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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