3
$\begingroup$

I have a set of velocity vectors that I'd like to plot as if I'd used ListVectorPlot3D.

Of course, I can't use ListVectorPlot3D as I don't have a true vector field to interpolate over, but rather just a discrete set of vectors.

Is there a nice way to access all of the styling conveniences of ListVectorPlot3D on this?

In general, if we can't build on top of an "System`" function, can we still build custom plot functions that make use of internal plotting convenience functions without handling the myriad little subcases ourselves?

$\endgroup$
2
$\begingroup$

Here's a way to, at a minimum, include plot styling on our custom functions:

applyPlotTheming[
  coreData_,
  baseFunction_,
  inheritFrom_,
  o : OptionsPattern[]
  ] :=
 Module[
  {
   inheritBase = Flatten[{inheritFrom}][[1]],
   theme,
   premethod,
   method,
   defaultstyle,
   defaultcf,
   cf,
   opts
   },
  opts = 
   Flatten @ {o};
  Quiet[
   theme = OptionValue[inheritFrom, opts, PlotTheme]
   ];
  theme = Charting`ResolvePlotTheme[theme, inheritBase];
  Quiet[premethod = Quiet@ OptionValue[inheritBase, theme, Method]];
  premethod = Charting`ConstructMethod@ premethod;
  theme = FilterRules[theme, Except @ Method];
  theme =
    FilterRules[
    theme,
    Join @@ Map[Options, Flatten[{inheritFrom}]]
    ];
  opts = Flatten[{opts, theme}];
  method = Quiet@OptionValue[inheritFrom, opts, Method];
  method =
   Charting`parseMethod[
    Charting`ConstructMethod@method,
    premethod
    ];
  {defaultstyle, defaultcf, cf} =
    Quiet @ 
    OptionValue[
     inheritFrom,
     Flatten @ {method, opts},
     {"DefaultPlotStyle", "DefaultColorFunction", ColorFunction}
     ];
  cf = Charting`customColorFunction[inheritBase, cf, defaultcf];
  opts =
   Join[
    opts,
    {
     "DefaultPlotStyle" -> defaultstyle,
     ColorFunction -> cf
     }
    ];
  baseFunction[
   coreData,
   Charting`FilterGraphicsOptions[
    Flatten@{opts, Method -> method},
    Options@baseFunction
    ]
   ]
  ]

I stole most of that code from the DownValues of System`VectorPlotsDump`iListVectorPlot3D.

Then if we want to use this we can make a low-level function that really just handles making some Graphics3D objects:

Options[customArrows3D] =
  Join[
   Options[ListVectorPlot3D],
   Options[System`VectorPlotsDump`iListVectorPlot3D],
   Charting`$GraphicsExtraOptions
   ];
customArrows3D[{coords_, vels_},  ops : OptionsPattern[]] :=
 Module[
  {
   velNorms = Norm /@ vels, 
   velMax,
   boxSize = 
    Max@{-(Subtract @@ MinMax@CoordinateBounds[coords]), .001},
   defps = OptionValue["DefaultPlotStyle"],
   cf =
    Replace[
     Charting`customColorFunction[
      ListVectorPlot3D,
      OptionValue[VectorColorFunction],
      OptionValue["DefaultColorFunction"]
      ],
     cd_ColorDataFunction :> (cd[#] &)
     ],
   velVecs,
   ps,
   hackColorMap
   },
  velMax = Max@velNorms;
  ps =
   Charting`customVectorStyle[ 
     OptionValue[VectorStyle],
     defps,
     1
     ][[1]];
  If[velMax != 0,
   velVecs = Thread[{coords, coords + vels*(boxSize/10/velMax)}];
   hackColorMap =
    If[cf === None,
     Nothing,
     Association@
      MapThread[
       #[[1]] -> (cf @@ Flatten[Prepend[##]]) &,
       {
        If[OptionValue@VectorColorFunctionScaling,
         Rescale@velVecs,
         velVecs
         ],
        If[OptionValue@VectorColorFunctionScaling,
         Rescale@velNorms,
         velNorms
         ]
        }
       ]
     ],
   hackColorMap =
    AssociationMap[Nothing,  Rescale@coords]
   ];
  Show[
   ListPointPlot3D[coords,
    FilterRules[
     Flatten@
      {
       ColorFunctionScaling ->
        OptionValue@VectorColorFunctionScaling,
       ColorFunction ->
        If[cf =!= None,
         With[{nf = Nearest[Keys@hackColorMap]},
          hackColorMap[nf[{#, #2, #3}][[1]]] &
          ],
         cf
         ],
       ops,
       PlotStyle -> ps,
       BoxRatios -> Automatic
       }, 
     Options@ListPointPlot3D
     ]
    ],
   If[velMax != 0,
    Graphics3D[
     MapThread[
      Flatten@*List,
      {
       Replace[Quiet@OptionValue[VectorScale],
        {
         Automatic :>

          Thread@Arrowheads[velNorms/velMax/25, 
            Appearance -> "Projected"],
         n : _?NumericQ :>

          Thread@Arrowheads[n*velNorms/velMax, 
            Appearance -> "Projected"],
         _ :>
          ConstantArray[
           Arrowheads[Appearance -> "Projected"],
           Length@velNorms
           ]
         }
        ],
       ConstantArray[ps, Length@velNorms],
       If[cf === None,
        Nothing,
        Values@hackColorMap
        ],
       Thread[Arrow@velVecs]
       }
      ],
     FilterRules[{ops}, Options@Graphics3D]
     ],
    {}
    ]
   ]
  ]

Note my use of some other functions poached from the DownValues: Charting`customColorFunction and Charting`customVectorStyle

And then by wrapping it we can make a function with better handling of theming and stuff:

myLVP3D[data_, ops : OptionsPattern[]] :=
 applyPlotTheming[
  data,
  customArrows3D,
  {ListVectorPlot3D, System`VectorPlotsDump`iListVectorPlot3D},
  ops
  ]

And here that is in action:

mydats =
  BlockRandom[
   SeedRandom[100];
   {
    RandomReal[{-10, 10}, {100, 3}],
    RandomReal[{-1, 1}, {100, 3}]
    }
   ];

Grid[
 {
  myLVP3D[mydats, PlotTheme -> #, ImageSize -> 250] & /@ {Automatic, 
    "Scientific", "Marketing"},
  myLVP3D[mydats, VectorColorFunction -> #, 
     ImageSize -> 250] & /@
   {"Rainbow", "AlpineColors", "DarkBands"}
  }
 ]

boop

Note one major issue with this, which is that the Ticks in every case except for the "Scientific" theme are coming from the ListPointPlot3D.

$\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.