坐标轴刻度自适应算法
2015-03-01 12:14:21   来源：lfg @ Fcode研讨团队   评论：0 点击：

数据作图时，纵横坐标轴刻度范围及刻度值的取法，很大程度上取决于数据的分布。对某一组数据，我们很容易就能知道如何选取这些值才能使图画得漂亮。但是要想找到一个通用的算法，用以对任意分布的数据决定这些值，并不是一件容易的事。

本算法可快速实现给定范围，刻度个数，自适应地获得应该显示的刻度值上下限，刻度值间距，及刻度值应该有多少位小数。

如下代码，运行后结果：
请输入坐标轴下限，上限：
3.13   5.67
3.0
3.5
4.0
4.5
5.0
5.5
6.0
请输入坐标轴下限，上限：
1123  5678
1000.
2000.
3000.
4000.
5000.
6000.
请输入坐标轴下限，上限：
103.130  103.156
103.125
103.130
103.135
103.140
103.145
103.150
103.155
103.160
请输入坐标轴下限，上限：

Module Fcode_Axes
  Implicit None
contains
  Subroutine Get_Axes_Tick( rMinVal , rMaxVal , nTick , graphmin , graphmax , d , nfrac )
    Real , Intent(IN)     :: rMinVal , rMaxVal
    Integer , Intent(IN)  :: nTick
    Integer , Intent(OUT) :: nfrac
    Real , Intent(OUT)    :: d , graphmin , graphmax
    Real :: range , t , rmax , rmin
    rmax = rMaxVal 
    rmin = rMinVal
    t = rmax - rmin
    if ( t < 10*tiny(t) ) then
      t = 1.0
      rmax = rmax + 0.5
      rmin = rmin - 0.5
    end if
    range = nicenum( t , 0 )
    d = nicenum( range / (nTick-1) , 1 )
    graphmin = floor( rmin / d ) * d
    graphmax = ceiling( rmax / d  ) * d
    nfrac = Max( -floor(log10(d)) , 0 )    
  End Subroutine Get_Axes_Tick
  
  Real Function NiceNum( x , round )
    Real , target ,save :: rNC(4) = [1.5,3.,7.,1e37] , rNV(4) = [1.,2.,5.,1e37]
    Real , target ,save :: rNS(4) = [1.,2.,5.,10.]
    Real :: x , f , nf(1)
    integer :: expv , round
    Real , pointer :: pN(:)
    expv = floor(log10(x))
    f = x / 10.0**expv
    If ( round /= 0 ) then
      pN => rNC
    Else
      pN => rNV
    End If
    nf = minloc( pN , mask=( f < pN ) )
    NiceNum = rNS(nf(1)) * (10.**expv)
  End Function NiceNum

End Module Fcode_Axes

Program www_fcode_cn
  Use Fcode_Axes
  Implicit None
  Real :: r1 , r2 , rmin , rmax , d , r
  integer :: nf
  Do
    write( * , '("请输入坐标轴下限，上限：")')
    read( * , * ) r1 , r2
    if ( r1 > r2 .or. abs(r1-r2)<1e-6 ) exit
    call Get_Axes_Tick( r1 , r2 , 5 , rmin , rmax , d , nf )
    r = rmin
    do
      write(*,'(f16.<nf>)') r !//此处 <nf> 用法不标准      
       r = r + d
      if ( r > rmax ) exit
    end do
  End Do
End Program www_fcode_cn