Skip to content

Commit 7e068c0

Browse files
jacobwilliamsjacobwilliams
committed
variable step cleanups
added automatic smooth color transition and different linestyles for the methods see #17
1 parent 019c752 commit 7e068c0

File tree

2 files changed

+133
-52
lines changed

2 files changed

+133
-52
lines changed

‎test/rk_test_variable_step.f90

Lines changed: 73 additions & 52 deletions
Original file line numberDiff line numberDiff line change
@@ -23,9 +23,15 @@ program rk_test_variable_step
2323
type(pyplot) :: plt, plt2
2424
integer :: istat
2525
character(len=3) :: rstr
26+
real(wp),dimension(3) :: hsl
27+
real(wp) :: hue_step
28+
integer :: ilinestyle
2629

2730
integer,parameter :: font_size = 30
28-
integer,parameter :: legend_fontsize = 20
31+
integer,parameter :: legend_fontsize = 15
32+
integer,parameter :: max_number_of_methods = 40 !! defines the step size for the colors
33+
34+
character(len=2),dimension(*),parameter :: linestyle = ['- ', '--', ': ']
2935

3036
! initialize plot
3137
call plt%initialize(grid=.true.,xlabel='Relative Error',&
@@ -41,50 +47,55 @@ program rk_test_variable_step
4147
legend_fontsize=legend_fontsize,&
4248
title='Variable-Step Runge Kutta Methods [Fixed-Step Mode]',legend=.true.)
4349

50+
! vary the hue and linestyle for each method in the plot:
51+
hsl = [0.0_wp, 1.0_wp, 0.5_wp]
52+
hue_step = 1.0_wp / max_number_of_methods
53+
ilinestyle = 0
54+
55+
! test of this routine:
56+
write(*,*) hslToRgb([0.9_wp, 1.0_wp, 0.5_wp]) / 255.0_wp
57+
! 1.00000000000000 0.000000000000000E+000 0.600000000000000
58+
! python comparison:
59+
! >>> colorsys.hls_to_rgb(0.9, 0.5, 1)
60+
! (1.0, 0.0, 0.5999999999999999)
61+
4462
! test all the methods:
45-
allocate(rkbs32_class :: s); allocate(s2, source=s); call run_all_tests('rkbs32', [255,0,0]); call finish()
46-
47-
allocate(rkf45_class :: s); allocate(s2, source=s); call run_all_tests('rkf45', [245, 152, 152]); call finish()
48-
49-
allocate(rkck54_class :: s); allocate(s2, source=s); call run_all_tests('rkck54', [255, 102, 0]); call finish()
50-
allocate(rkdp54_class :: s); allocate(s2, source=s); call run_all_tests('rkdp54', [189, 90, 25]); call finish()
51-
allocate(rkt54_class :: s); allocate(s2, source=s); call run_all_tests('rkt54', [143, 78, 36]); call finish()
52-
allocate(rks54_class :: s); allocate(s2, source=s); call run_all_tests('rks54', [243, 78, 36]); call finish()
53-
54-
allocate(rkdp65_class :: s); allocate(s2, source=s); call run_all_tests('rkdp65', [251, 255, 0]); call finish()
55-
allocate(rkc65_class :: s); allocate(s2, source=s); call run_all_tests('rkc65', [207, 194, 145]);call finish()
56-
allocate(rktp64_class :: s); allocate(s2, source=s); call run_all_tests('rktp64', [187, 189, 49]); call finish()
57-
allocate(rkv65e_class :: s); allocate(s2, source=s); call run_all_tests('rkv65e', [149, 150, 63]); call finish()
58-
allocate(rkv65r_class :: s); allocate(s2, source=s); call run_all_tests('rkv65r', [65, 71, 41]); call finish()
59-
allocate(rkv65_class :: s); allocate(s2, source=s); call run_all_tests('rkv65', [75, 81, 51]); call finish()
60-
allocate(rktf65_class :: s); allocate(s2, source=s); call run_all_tests('rktf65', [2, 2, 2]); call finish()
61-
62-
allocate(rktp75_class :: s); allocate(s2, source=s); call run_all_tests('rktp75', [0, 255, 38]); call finish()
63-
allocate(rktmy7_class :: s); allocate(s2, source=s); call run_all_tests('rktmy7', [102, 247, 255]); call finish()
64-
allocate(rkv76e_class :: s); allocate(s2, source=s); call run_all_tests('rkv76e', [38, 189, 60]); call finish()
65-
allocate(rkv76r_class :: s); allocate(s2, source=s); call run_all_tests('rkv76r', [149, 163, 93]); call finish()
66-
allocate(rkf78_class :: s); allocate(s2, source=s); call run_all_tests('rkf78', [66, 143, 77]); call finish()
67-
allocate(rkv78_class :: s); allocate(s2, source=s); call run_all_tests('rkv78', [77, 105, 81]); call finish()
68-
69-
allocate(rktp86_class :: s); allocate(s2, source=s); call run_all_tests('rktp86', [0, 47, 255]); call finish()
70-
allocate(rkdp87_class :: s); allocate(s2, source=s); call run_all_tests('rkdp87', [51, 83, 222]); call finish()
71-
allocate(rkv87e_class :: s); allocate(s2, source=s); call run_all_tests('rkv87e', [90, 116, 230]); call finish()
72-
allocate(rkv87r_class :: s); allocate(s2, source=s); call run_all_tests('rkv87r', [0,0,0]); call finish()
73-
allocate(rkk87_class :: s); allocate(s2, source=s); call run_all_tests('rkk87', [10,10,10]); call finish()
74-
allocate(rkf89_class :: s); allocate(s2, source=s); call run_all_tests('rkf89', [116, 133, 207]); call finish()
75-
allocate(rkv89_class :: s); allocate(s2, source=s); call run_all_tests('rkv89', [169, 176, 219]); call finish()
76-
77-
allocate(rkt98a_class :: s); allocate(s2, source=s); call run_all_tests('rkt98a', [195, 0, 255]); call finish()
78-
allocate(rkv98e_class :: s); allocate(s2, source=s); call run_all_tests('rkv98e', [192, 52, 235]); call finish()
79-
allocate(rkv98r_class :: s); allocate(s2, source=s); call run_all_tests('rkv98r', [79, 5, 153]); call finish()
80-
allocate(rkf108_class :: s); allocate(s2, source=s); call run_all_tests('rkf108', [198, 149, 245]); call finish()
81-
allocate(rkc108_class :: s); allocate(s2, source=s); call run_all_tests('rkc108', [232, 207, 255]); call finish()
82-
allocate(rkb109_class :: s); allocate(s2, source=s); call run_all_tests('rkb109', [200, 180, 230]); call finish()
83-
84-
allocate(rks1110a_class :: s); allocate(s2, source=s); call run_all_tests('rks1110a',[0,0,0]); call finish()
85-
allocate(rkf1210_class :: s); allocate(s2, source=s); call run_all_tests('rkf1210', [94,94,94]); call finish()
86-
allocate(rko129_class :: s); allocate(s2, source=s); call run_all_tests('rko129', [145, 145, 145]); call finish()
87-
allocate(rkf1412_class :: s); allocate(s2, source=s); call run_all_tests('rkf1412', [225, 230, 230]); call finish()
63+
allocate(rkbs32_class :: s); call run_all_tests('rkbs32' )
64+
allocate(rkf45_class :: s); call run_all_tests('rkf45' )
65+
allocate(rkck54_class :: s); call run_all_tests('rkck54' )
66+
allocate(rkdp54_class :: s); call run_all_tests('rkdp54' )
67+
allocate(rkt54_class :: s); call run_all_tests('rkt54' )
68+
allocate(rks54_class :: s); call run_all_tests('rks54' )
69+
allocate(rkdp65_class :: s); call run_all_tests('rkdp65' )
70+
allocate(rkc65_class :: s); call run_all_tests('rkc65' )
71+
allocate(rktp64_class :: s); call run_all_tests('rktp64' )
72+
allocate(rkv65e_class :: s); call run_all_tests('rkv65e' )
73+
allocate(rkv65r_class :: s); call run_all_tests('rkv65r' )
74+
allocate(rkv65_class :: s); call run_all_tests('rkv65' )
75+
allocate(rktf65_class :: s); call run_all_tests('rktf65' )
76+
allocate(rktp75_class :: s); call run_all_tests('rktp75' )
77+
allocate(rktmy7_class :: s); call run_all_tests('rktmy7' )
78+
allocate(rkv76e_class :: s); call run_all_tests('rkv76e' )
79+
allocate(rkv76r_class :: s); call run_all_tests('rkv76r' )
80+
allocate(rkf78_class :: s); call run_all_tests('rkf78' )
81+
allocate(rkv78_class :: s); call run_all_tests('rkv78' )
82+
allocate(rktp86_class :: s); call run_all_tests('rktp86' )
83+
allocate(rkdp87_class :: s); call run_all_tests('rkdp87' )
84+
allocate(rkv87e_class :: s); call run_all_tests('rkv87e' )
85+
allocate(rkv87r_class :: s); call run_all_tests('rkv87r' )
86+
allocate(rkk87_class :: s); call run_all_tests('rkk87' )
87+
allocate(rkf89_class :: s); call run_all_tests('rkf89' )
88+
allocate(rkv89_class :: s); call run_all_tests('rkv89' )
89+
allocate(rkt98a_class :: s); call run_all_tests('rkt98a' )
90+
allocate(rkv98e_class :: s); call run_all_tests('rkv98e' )
91+
allocate(rkv98r_class :: s); call run_all_tests('rkv98r' )
92+
allocate(rkf108_class :: s); call run_all_tests('rkf108' )
93+
allocate(rkc108_class :: s); call run_all_tests('rkc108' )
94+
allocate(rkb109_class :: s); call run_all_tests('rkb109' )
95+
allocate(rks1110a_class :: s); call run_all_tests('rks1110a')
96+
allocate(rkf1210_class :: s); call run_all_tests('rkf1210' )
97+
allocate(rko129_class :: s); call run_all_tests('rko129' )
98+
allocate(rkf1412_class :: s); call run_all_tests('rkf1412' )
8899

89100
! save plot:
90101
write(rstr,'(I3)') wp
@@ -94,17 +105,25 @@ program rk_test_variable_step
94105
contains
95106
!*****************************************************************************************
96107

97-
subroutine finish()
98-
deallocate(s); deallocate(s2)
99-
end subroutine finish
100-
101-
subroutine run_all_tests(method,color)
108+
subroutine run_all_tests(method)
102109
!! run all the tests
103110
character(len=*),intent(in) :: method !! name of the RK method to use
104-
integer,dimension(3),intent(in) :: color !! color for the plot
111+
112+
integer,dimension(3) :: color !! color for the plot
113+
114+
allocate(s2, source=s)
115+
116+
! update color and linestyle:
117+
hsl(1) = hsl(1) + hue_step
118+
color = hslToRgb(hsl)
119+
ilinestyle = ilinestyle + 1
120+
if (ilinestyle>size(linestyle)) ilinestyle = 1
121+
105122
call performance_test(method,color)
106123
call performance_test_fixed(method,color)
107124
call run_test(method)
125+
deallocate(s); deallocate(s2)
126+
108127
end subroutine run_all_tests
109128

110129
subroutine performance_test(method,color)
@@ -186,7 +205,8 @@ subroutine performance_test(method,color)
186205
! add to the plot:
187206
call plt%add_plot(r_error,real(feval,wp),&
188207
label=method,&
189-
linestyle='.-',color=real(color/255.0_wp,wp),&
208+
linestyle=linestyle(ilinestyle),&
209+
color=real(color/255.0_wp,wp),&
190210
markersize=5,linewidth=4,istat=istat,&
191211
xscale='log',yscale='log')
192212

@@ -257,7 +277,8 @@ subroutine performance_test_fixed(method,color)
257277
! add to the plot:
258278
call plt2%add_plot(r_error,real(feval,wp),&
259279
label=method,&
260-
linestyle='.-',color=real(color/255.0_wp,wp),&
280+
linestyle=linestyle(ilinestyle),&
281+
color=real(color/255.0_wp,wp),&
261282
markersize=5,linewidth=4,istat=istat,&
262283
xscale='log',yscale='log')
263284

‎test/test_support.f90

Lines changed: 60 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ module test_support
1010
real(wp),parameter,public :: deg2rad = acos(-1.0_wp) / 180.0_wp
1111

1212
public :: orbital_elements_to_rv
13+
public :: hslToRgb
1314

1415
contains
1516
!*****************************************************************************************
@@ -96,4 +97,63 @@ pure subroutine orbit_check(ecc,inc,circular,equatorial)
9697
end subroutine orbit_check
9798
!*****************************************************************************************
9899

100+
!*****************************************************************************************
101+
!>
102+
! Converts an HSL color value to RGB.
103+
!
104+
! See: https://stackoverflow.com/questions/2353211/hsl-to-rgb-color-conversion
105+
106+
function hslToRgb(hsl) result(rgb)
107+
108+
real(wp),dimension(3),intent(in) :: hsl !! [h,s,l] in range [0.0, 1.0]
109+
integer,dimension(3) :: rgb !! [r,g,b] in range [0, 255]
110+
111+
real(wp) :: h,s,l,r,g,b,p,q
112+
113+
h = hsl(1)
114+
s = hsl(2)
115+
l = hsl(3)
116+
117+
if (l < 0.5_wp) then
118+
q = l * (1 + s)
119+
else
120+
q = l + s - l * s
121+
end if
122+
123+
p = 2.0_wp * l - q
124+
125+
if (s == 0.0_wp) then
126+
r = l; g = l; b = l ! achromatic
127+
else
128+
r = hueToRgb(p, q, h + 1.0_wp/3.0_wp)
129+
g = hueToRgb(p, q, h)
130+
b = hueToRgb(p, q, h - 1.0_wp/3.0_wp)
131+
end if
132+
rgb = [to255(r), to255(g), to255(b)]
133+
134+
contains
135+
integer function to255(v)
136+
!! Helper method that converts hue to rgb
137+
real(wp),intent(in) :: v
138+
to255 = int(min(255.0_wp,256.0_wp*v))
139+
end function to255
140+
141+
function hueToRgb(p, q, t) result(r)
142+
real(wp),value :: p,q,t
143+
real(wp) :: r
144+
if (t < 0.0_wp) t = t + 1.0_wp
145+
if (t > 1.0_wp) t = t - 1.0_wp
146+
if (t < 1.0_wp/6.0_wp) then
147+
r = p + (q - p) * 6.0_wp * t
148+
else if (t < 1.0_wp/2.0_wp) then
149+
r = q
150+
else if (t < 2.0_wp/3.0_wp) then
151+
r = p + (q - p) * (2.0_wp/3.0_wp - t) * 6.0_wp
152+
else
153+
r = p
154+
end if
155+
end function hueToRgb
156+
157+
end function hslToRgb
158+
99159
end module test_support

0 commit comments

Comments
 (0)