2
$\begingroup$

The Problem

I want to be able to change the colour of parts of lines in Graphics 3D. I don't know a good way.

Below is how I've got so far and a diagram of I want. I.e. I want to be able to control the colour of the line segments from data. The integer value between 400-700nm should be the colour. (these can be simplified if required)

enter image description here

enter image description here

Example Data & Plotting Code

photonlives = {{{"Start", {8.908399661129824`, 9.633102260661355`, 5}, 407}, {"Emission", {8.908399661129824`, 9.633102260661355`, 2.496926971098662`},407}, {"Left", {11.087670534918876`, 8.219492769746015`, 3.432302819553219`},300}}, {{"Start", {1.9856853654615514`, 6.848440992081457`, 5},594}, {"Emission", {1.9856853654615514`, 6.848440992081457`, 2.6228644835985957`},594}, {"Left", {2.521141087121206`, 5.323725115908513`, 3.012965011108447`},300}}, {{"Start", {5.382360511331741`, 4.408513016017577`, 5},524}, {"Emission", {5.382360511331741`, 4.408513016017577`, 2.0636538349485796`},524}, {"Emission", {5.9510903463320135`, 6.191633074632532`, 1.365916379273969`},300}, {"Emission", {4.141206920229977`, 5.773532803626935`, 1.1486020989253132`},300}, {"Absorbed", {4.731487780277531`, 3.5166296163565747`, 0.9018958429272086`},300}}, {{"Start", {5.7064477543041985`, 8.960806835584687`, 5},499}, {"Absorbed", {5.7064477543041985`, 8.960806835584687`, 2.6904886316076606`},499}}, {{"Start", {8.290340872256385`, 2.9730634116539956`, 5},409}, {"Reflection", {8.290340872256385`, 2.9730634116539956`, 3}, 409}, {"Left", {9.25283380442492`, 0.9128219903837054`, 5},409}}, {{"Start", {7.109178085659753`, 1.4811083443707118`, 5},537}, {"Emission", {7.109178085659753`, 1.4811083443707118`, 2.3677442987465627`},537}, {"Left", {5.423234919050124`, -0.4911618443561132`, 1.6554688841042937`},300}}, {{"Start", {3.6761465640204927`, 9.226495379895743`, 5},606}, {"Reflection", {3.6761465640204927`, 9.226495379895743`, 3}, 606}, {"Left", {0.5167471944485746`, 4.671778417759236`, 5}, 606}}, {{"Start", {4.383581619316823`, 2.2526259659816184`, 5},401}, {"Reflection", {4.383581619316823`, 2.2526259659816184`, 3}, 401}, {"Left", {9.404425720369971`, 4.8467050372875775`, 5},  401}}, {{"Start", {1.9099177632828113`, 8.593414202432443`, 5},560}, {"Emission", {1.9099177632828113`, 8.593414202432443`, 2.6092504664365213`},560}, {"Emission", {2.7699445700893683`, 7.423796219035573`, 2.624089283248043`},300}, {"Left", {0.5502206495992263`, 5.467835704409955`, 3.3137618986450716`},300}}, {{"Start", {3.6746266719085408`, 0.28929707744424604`, 5}, 592}, {"Emission", {3.6746266719085408`, 0.28929707744424604`, 2.4109510252927`},592}, {"Emission", {1.8174965321127263`, 2.541633357705031`, 2.7993512767850586`},300}, {"Absorbed", {2.371991341538078`, 0.5034533844835565`, 2.686939720078675`}, 300}}};

Graphics3D[{Line[photonlives[[All, All, 2]]], {Opacity[0.2], Cuboid[{0, 0, 0}, {10, 10, 3}]}}]

I'm really at a lost end - any idea would be helpful.


Background

I have a program which tracks what photons are doing in a box filled with plastic. It contains a dye which will absorb and re-emit the light at a new colour/frequency. The "frequency in nm" should correspond to a colour

It produces output which gives a list for each photon which describes the life of the photon. It looks like.

{{"Process 1"}, {"x","y","z"}, {"frequency in nm"}, {"Process 2"}, {"x","y","z"}, {"frequency in nm"}, ... } 

An example is

{{"Start", {8.9, 9.6, 5}, 407}, {"Emission", {8.9, 9.6, 2.5}, 407}, {"Left", {11.0, 8.2, 3.4}, 300}}

Each photon starts which a location with Start. Then, there are 4 processes available - reflection (which means the photon doesn't get into the box), absorption (which kills the photon in the box), emission (which means the frequency of the photon is changed) and left (which means the photon has left the interesting area).

I have attached the whole code which generates the above figure, in case there might be a better way of dealing with the data.

(* This number of times we track the photon *) 
numberofphotons = 1000; 
(*array to track the photons *) 
photonlives = ConstantArray[0, numberofphotons];

(* the size of our box *) 
xbox = 10; 
ybox = 10; 
zbox = 3; 

dyefreq = 300;

For[i = 1, i <= numberofphotons, i++, 

 Photonabsorbedflag = 0; 
 (* Photons begin above the box in a random location*) 
 x = RandomReal[]*xbox; 
 y = RandomReal[]*ybox;
 z = 5; 

 (* Pick the colour of the photons *) 
 lamda = RandomInteger[{400, 700}];

 (* Record where the photon begins *) 
 photonlives[[i]] = {{"Start", {x, y, z}, lamda}};


 (* Reflection *) 
 If[ RandomReal[] < 0.4,  

  (* Find location of reflection *) 
  photonlives[[i]] = 
   Append[photonlives[[i]] , {"Reflection", {x, y, 3}, lamda}];

  (* Assume the photons are scattered randomly *) 
  photonlives[[i]] = 
   Append[photonlives[[i]] , {"Left", {RandomReal[]*xbox, 
      RandomReal[]*ybox, 5}, lamda}];

  (* Begin next photon *) 
  Continue[]
  ];


 (* ------- In the Plastic Block -------*) 


 pathlengthz = RandomReal[]* zbox/3; 
  z = 3 - pathlengthz;

 While[ x > 0 && x < xbox && y > 0 && y < ybox && z > 0 && z < zbox, 

  (* Photon absorbed by substrate and just dies *) 

  If[RandomReal[] < 0.2,

   photonlives[[i]] = 
    Append[photonlives[[i]] , {"Absorbed", {x, y, z}, lamda}];
   Photonabsorbedflag = 1; 
   (*breaks while loop*) 
   Break[];

   ];

  (* Photon absorbed by dye and remitted at new freq *)

  If[RandomReal[] < 0.4,

   photonlives[[i]] = 
    Append[photonlives[[i]] , {"Emission", {x, y, z}, lamda}];

   pathlengthx = RandomReal[{-1, 1}]* xbox/3;
   pathlengthy = RandomReal[{-1, 1}]* ybox/3;
   pathlengthz = RandomReal[{-1, 1}]* zbox/3;

   x = x + pathlengthx;
   y = y + pathlengthy;
   z = z + pathlengthz;

   lamda = dyefreq; 
   (*breaks while loop*) 
   ];

  ];

 If[Photonabsorbedflag == 0, 
  photonlives[[i]] = 
   Append[photonlives[[i]] , {"Left", {x, y, z}, lamda}]

  ];
 ]
Graphics3D[{Line[photonlives[[All, All, 2]]], {Opacity[0.2], 
   Cuboid[{0, 0, 0}, {xbox, ybox, zbox}]}}]
$\endgroup$
  • $\begingroup$ This kind of work can be done easily in Optica (opticasoftware.com). $\endgroup$ – David G. Stork Dec 26 '17 at 17:56
  • 1
    $\begingroup$ I agree - but it seems expensive ($2000!) method just to add colour =P . I have no need for fancy ray tracing software, I just want to add some colour. $\endgroup$ – Tomi Dec 26 '17 at 17:59
4
$\begingroup$

I'm not sure how important it is that each line segment has a constant color, but you could give each point a VertexColor. This is as simple as

colorLine[entry_] := With[{pts = Transpose[entry][[2 ;;]]},
  Tube[pts[[1]], VertexColors -> (ColorData["VisibleSpectrum"] /@ pts[[2]])]
];
Graphics3D[colorLine /@ photonlives]

Mathematica graphics

Edit

colorLine[entry_] := {ColorData["VisibleSpectrum", Last[#3]], Tube[#2]} & @@@ 
  (Transpose[#] & /@ Partition[entry, 2, 1])
Graphics3D[colorLine /@ photonlives]

Mathematica graphics

$\endgroup$
  • $\begingroup$ I would really appreciate if the line segment could have a constant colour - but maybe that simple isn't an option. $\endgroup$ – Tomi Dec 27 '17 at 10:53
  • $\begingroup$ @Tomi Your data-structure has a color connected the every point. A line is a connection between two points that might have a different color. How do you plan to determine the color for the line? $\endgroup$ – halirutan Dec 28 '17 at 8:20
  • $\begingroup$ The line to the point should be the colour described in each entry in the dataset. i.e. in the example {{"Start", {8.9, 9.6, 5}, 407}, {"Emission", {8.9, 9.6, 2.5}, 407}, {"Left", {11.0, 8.2, 3.4}, 300}}, the first line segment should be the 407 colour, then the second line segment the 300 colour. $\endgroup$ – Tomi Dec 28 '17 at 18:06

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.