彭国伦书中派生分数类型的扩展

weixing1531

彭国伦书中展示了F95标准下派生分数类型的实现
本代码在此基础上，运用F2003标准中的派生类型绑定和操作符重载，进一步扩展了派生分数类型


有一项功能还没有实现，即浮点数类型赋值给派生分数类型 subroutine  rat_eq_ real
思路大致是把浮点数划分成两部分，一部分为整数部分，另一部分为小数部分
然后让小数部分转换成派生分数类型
由于计算机中浮点数的特殊性
多数情况下只能近似转换
不知道有没有别的好办法？

weixing1531

源代码如下

[Fortran] syntaxhighlighter_viewsource syntaxhighlighter_copycode

module rational_class
  implicit none
  private

  type,public :: rational !分数类
  	private

    integer :: num    ! 分子
    integer :: denom  ! 分母
  contains
    private
    ! 加法+
    procedure,pass(this) :: rat__rat_plus_rat,rat__int_plus_rat,rat__rat_plus_int
    generic,public :: operator(+) => rat__rat_plus_rat,rat__int_plus_rat,rat__rat_plus_int
    ! 减法-
    procedure,pass(this) :: rat__rat_minus_rat,rat__int_minus_rat,rat__rat_minus_int
    generic,public :: operator(-) => rat__rat_minus_rat,rat__int_minus_rat,rat__rat_minus_int
    ! 乘法*
    procedure,pass(this) :: rat__rat_times_rat,rat__int_times_rat,rat__rat_times_int
    generic,public :: operator(*) => rat__rat_times_rat,rat__int_times_rat,rat__rat_times_int
    ! 除法/
    procedure,pass(this) :: rat__rat_div_rat,rat__int_div_rat,rat__rat_div_int
    generic,public :: operator(/) => rat__rat_div_rat,rat__int_div_rat,rat__rat_div_int
    ! 乘方**
    procedure,pass(this) :: rat__rat_exp_int
    generic,public :: operator(**) => rat__rat_exp_int
    ! 赋值=
    procedure,pass(this) :: rat_eq_rat,int_eq_rat,real_eq_rat,rat_eq_int
    generic,public :: assignment(=) => rat_eq_rat,int_eq_rat,real_eq_rat,rat_eq_int
    ! 大于>
    procedure,pass(this) :: rat_gt_rat,int_gt_rat,rat_gt_int
    generic,public :: operator(>) => rat_gt_rat,int_gt_rat,rat_gt_int
    ! 小于<
    procedure,pass(this) :: rat_lt_rat,int_lt_rat,rat_lt_int
    generic,public :: operator(<) => rat_lt_rat,int_lt_rat,rat_lt_int
    ! 等于==
    procedure,pass(this) :: rat_compare_rat,int_compare_rat,rat_compare_int
    generic,public :: operator(==) => rat_compare_rat,int_compare_rat,rat_compare_int
    ! 不等于/=
    procedure,pass(this) :: rat_ne_rat,int_ne_rat,rat_ne_int
    generic,public :: operator(/=) => rat_ne_rat,int_ne_rat,rat_ne_int
    ! >=
    procedure,pass(this) :: rat_ge_rat,int_ge_rat,rat_ge_int
    generic,public :: operator(>=) => rat_ge_rat,int_ge_rat,rat_ge_int
    ! <=
    procedure,pass(this) :: rat_le_rat,int_le_rat,rat_le_int
    generic,public :: operator(<=) => rat_le_rat,int_le_rat,rat_le_int

    procedure,pass(this),public :: output,input,set
  end type rational
contains
  ! 分数>分数
  function rat_gt_rat(this,b)  !改动
    logical :: rat_gt_rat
    class(rational), intent(in) :: this,b !改动
    type(rational) :: fa  !改动

    fa = (this - b)  !与彭国伦书上算法不同

    if (fa%num > 0)then !差值的分子大于0
      rat_gt_rat = .true.
    else
      rat_gt_rat = .false.
    end if

    return
  end function rat_gt_rat
  ! 整数>分数
  function int_gt_rat(a,this)  !改动
    logical :: int_gt_rat
    integer,intent(in) :: a
    class(rational),intent(in) :: this  !改动
    type(rational) :: fa  !改动

    fa = (a - this)

    if (fa%num > 0)then !差值的分子大于0
      int_gt_rat = .true.
    else
      int_gt_rat = .false.
    end if

    return
  end function int_gt_rat
  ! 分数>整数
  function rat_gt_int(this,b)  !改动
    logical :: rat_gt_int
    class(rational),intent(in) :: this  !改动
    integer,intent(in) :: b
    type(rational) :: fa  !改动

    fa = (this - b)  !改动

    if (fa%num > 0)then !差值的分子大于0
      rat_gt_int = .true.
    else
      rat_gt_int = .false.
    end if

    return
  end function rat_gt_int
  ! 分数<分数
  function rat_lt_rat(this,b)  !改动
    logical :: rat_lt_rat
    class(rational), intent(in) :: this,b  !改动
    !利用等价
    rat_lt_rat = rat_gt_rat(b,this) !利用现有函数

    return
  end function rat_lt_rat
  ! 整数<分数
  function int_lt_rat(a,this)  !改动
    logical :: int_lt_rat
    integer,intent(in) :: a
    class(rational),intent(in) :: this  !改动
    !利用等价
    int_lt_rat = rat_gt_int(this,a) !利用现有函数
    
    return
  end function int_lt_rat
  ! 分数<整数
  function rat_lt_int(this,b)  !改动
    logical :: rat_lt_int
    class(rational),intent(in) :: this  !改动
    integer,intent(in) :: b
    !利用等价
    rat_lt_int = int_gt_rat(b,this) !利用现有函数

    return
  end function rat_lt_int
  ! 分数==分数
  function rat_compare_rat(this,b)  !改动
    logical :: rat_compare_rat
    class(rational), intent(in) :: this,b  !改动
    type(rational) :: c  !改动

    c = (this - b)  !改动

    if ( c%num == 0 ) then !差值的分子等于0
      rat_compare_rat = .true.
    else
      rat_compare_rat = .false.
    end if

    return
  end function rat_compare_rat
  ! 整数==分数
  function int_compare_rat(a,this)  !改动
    logical :: int_compare_rat
    integer,intent(in) :: a
    class(rational), intent(in) :: this  !改动
    !利用等价
    int_compare_rat = rat_compare_int(this,a) !利用现有函数

    return
  end function int_compare_rat
  ! 分数==整数
  function rat_compare_int(this,b)  !改动
    logical :: rat_compare_int
    class(rational), intent(in) :: this  !改动
    integer,intent(in) :: b
    type(rational) :: c !改动

    c = (this - b)  !改动

    if ( c%num == 0 ) then !差值的分子等于0
      rat_compare_int = .true.
    else
      rat_compare_int = .false.
    end if

    return
  end function rat_compare_int
  ! 分数/=分数
  function rat_ne_rat(this,b)  !改动
    logical :: rat_ne_rat
    class(rational), intent(in) :: this,b  !改动
    
    rat_ne_rat = .not.rat_compare_rat(this,b) !利用现有函数
    
    return
  end function rat_ne_rat
  ! 整数/=分数
  function int_ne_rat(a,this)  !改动
    logical :: int_ne_rat
    integer,intent(in) :: a
    class(rational), intent(in) :: this  !改动
    
    int_ne_rat = .not.int_compare_rat(a,this) !利用现有函数

    return
  end function int_ne_rat
  ! 分数/=整数
  function rat_ne_int(this,b)  !改动
    logical :: rat_ne_int
    class(rational), intent(in) :: this  !改动
    integer,intent(in) :: b
    
    rat_ne_int = .not.rat_compare_int(this,b) !利用现有函数
    
    return
  end function rat_ne_int
  ! 分数>=分数
  function rat_ge_rat(this,b)  !改动
    logical :: rat_ge_rat
    class(rational), intent(in) :: this,b !改动

    rat_ge_rat = rat_gt_rat(this,b) .or. rat_compare_rat(this,b) !利用现有函数

    return
  end function rat_ge_rat
  ! 整数>=分数
  function int_ge_rat(a,this)  !改动
    logical :: int_ge_rat
    integer,intent(in) :: a
    class(rational),intent(in) :: this  !改动

    int_ge_rat = int_gt_rat(a,this) .or. int_compare_rat(a,this) !利用现有函数

    return
  end function int_ge_rat
  ! 分数>=整数
  function rat_ge_int(this,b)  !改动
    logical :: rat_ge_int
    class(rational),intent(in) :: this  !改动
    integer,intent(in) :: b

    rat_ge_int = rat_gt_int(this,b) .or. rat_compare_int(this,b) !利用现有函?
    
    return
  end function rat_ge_int
  ! 分数<=分数
  function rat_le_rat(this,b)  !改动
    logical :: rat_le_rat
    class(rational), intent(in) :: this,b !改动
    !利用等价
    rat_le_rat = rat_ge_rat(b,this) !利用现有函数

    return
  end function rat_le_rat
  ! 整数<=分数
  function int_le_rat(a,this)  !改动
    logical :: int_le_rat
    integer,intent(in) :: a
    class(rational),intent(in) :: this  !改动
    !利用等价
    int_le_rat = rat_ge_int(this,a) !利用现有函数

    return
  end function int_le_rat
  ! 分数<=整数
  function rat_le_int(this,b)  !改动
    logical :: rat_le_int
    class(rational),intent(in) :: this  !改动
    integer,intent(in) :: b
    !利用等价
    rat_le_int = int_ge_rat(b,this) !利用现有函数
    
    return
  end function rat_le_int
  ! 分数=分数
  subroutine rat_eq_rat( rat1, this ) !改动
    class(rational), intent(out) :: rat1 !改动
    class(rational), intent(in) :: this !改动

    rat1%num   = this%num
    rat1%denom = this%denom

    return
  end subroutine rat_eq_rat
  ! 整数=分数
  subroutine int_eq_rat( int, this )  !改动
    integer, intent(out) :: int
    class(rational), intent(in) :: this !改动

    int = this%num / this%denom

    return
  end subroutine int_eq_rat
  ! 分数=整数
  subroutine rat_eq_int( this, int )  !改动
    integer, intent(in) :: int
    class(rational), intent(out) :: this !改动

    this%num = int
    this%denom = 1 

    return
  end subroutine rat_eq_int
  ! 浮点数=分数
  subroutine real_eq_rat( float, this ) !改动
    real, intent(out) :: float
    class(rational), intent(in) :: this !改动

    float = real(this%num) / real(this%denom) !改动

    return
  end subroutine real_eq_rat

weixing1531

[Fortran] syntaxhighlighter_viewsource syntaxhighlighter_copycode

  ! 化简分数
  function reduse( a )
    type(rational), intent(in) :: a
    type(rational) :: temp
    integer :: b
    integer :: sign
    type(rational) :: reduse

    if ( a%num*a%denom > 0 ) then !同号
      sign=1
    else !异号
      sign=-1
    end if
    
    temp%num=abs(a%num) !取分子绝对值
    temp%denom=abs(a%denom) !取分母绝对值
    b=gcv(temp%num,temp%denom)  ! 找正分子与正分母的最大公因数
    ! 把正分子,正分母同除以最大公因数
    reduse%num = temp%num/b*sign
    reduse%denom = temp%denom/b !保证约分后分母仍为正数
    
    return
  end function reduse
  ! 用辗转相除法找最大公因数
  function gcv(a,b)
    integer, intent(in) :: a,b
    integer :: big,small
    integer :: temp
    integer :: gcv

    big=max(a,b)
    small=min(a,b)
    
    do while( small>1 )
      temp=mod(big,small)
      if ( temp == 0 ) exit
      big=small
      small=temp
    end do
    
    gcv=small
    return
  end function gcv

  function rat__rat_plus_rat( this, rat2 ) !改动
    type(rational) :: rat__rat_plus_rat
    class(rational), intent(in) :: this,rat2 !改动
    type(rational) :: act

    act%denom = this%denom * rat2%denom !改动  公分母
    act%num  = this%num * rat2%denom + rat2%num * this%denom !改动
    rat__rat_plus_rat = reduse(act)

    return
  end function rat__rat_plus_rat
  
  function rat__int_plus_rat(int,this) !改动
    type(rational) :: rat__int_plus_rat !改动
    integer,intent(in) :: int
    class(rational),intent(in) :: this !改动
    !加法交换律
    rat__int_plus_rat = rat__rat_plus_int(this,int) !利用现有函数
    
    return
  end function rat__int_plus_rat
  
  function rat__rat_plus_int(this,int) !改动
    type(rational) :: rat__rat_plus_int !改动
    class(rational),intent(in) :: this !改动
    integer,intent(in) :: int
    type(rational) :: act !改动
    
    act%denom = this%denom !改动
    act%num = this%denom * int + this%num !改动
    rat__rat_plus_int = reduse(act)
    
    return
  end function rat__rat_plus_int

  function rat__rat_minus_rat( this, rat2 ) !改动
    type(rational) :: rat__rat_minus_rat
    class(rational), intent(in) :: this, rat2 !改动
    type(rational) :: temp

    temp%denom = this%denom * rat2%denom !改动  公分母
    temp%num   = this%num * rat2%denom - rat2%num * this%denom !改动
    rat__rat_minus_rat = reduse( temp )

    return
  end function rat__rat_minus_rat
  
  function rat__int_minus_rat(int,this) !改动
    type(rational) :: rat__int_minus_rat !改动
    integer,intent(in) :: int
    class(rational),intent(in) :: this !改动
    type(rational) :: temp !改动
    
    temp%denom = this%denom !改动
    temp%num = this%denom * int - this%num !改动
    rat__int_minus_rat = reduse(temp)
    
    return
  end function rat__int_minus_rat
  
  function rat__rat_minus_int(this,int) !改动
    type(rational) :: rat__rat_minus_int !改动
    class(rational),intent(in) :: this !改动
    integer,intent(in) :: int
    !a-b=a+(-b)
    rat__rat_minus_int = rat__rat_plus_int(this,-int) !利用现有函数
    
    return
  end function rat__rat_minus_int

  function rat__rat_times_rat( this, rat2 ) !改动
    type(rational) :: rat__rat_times_rat
    class(rational), intent(in) :: this, rat2 !改动
    type(rational) :: temp

    temp%denom = this%denom* rat2%denom !改动
    temp%num   = this%num  * rat2%num !改动
    rat__rat_times_rat = reduse(temp)

    return
  end function rat__rat_times_rat
  
  function rat__int_times_rat(int,this) !改动
    type(rational) :: rat__int_times_rat !改动
    integer,intent(in) :: int
    class(rational), intent(in) :: this !改动
    !乘法交换律
    rat__int_times_rat=rat__rat_times_int(this,int)  !利用现有函数
    
    return
  end function rat__int_times_rat
  
  function rat__rat_times_int(this,int) !改动
    type(rational) :: rat__rat_times_int !改动
    class(rational), intent(in) :: this !改动
    integer,intent(in) :: int
    type(rational) :: temp !改动
    
    temp%denom = this%denom !改动
    temp%num = this%num * int !改动
    rat__rat_times_int = reduse(temp)
    
    return
  end function rat__rat_times_int
  
  function rat__rat_div_rat( this, rat2 ) !改动
    type(rational) :: rat__rat_div_rat
    class(rational), intent(in) :: this, rat2 !改动
    type(rational) :: temp

    temp%denom = this%denom * rat2%num !改动
    temp%num   = this%num  * rat2%denom !改动
    rat__rat_div_rat = reduse(temp)

    return
  end function rat__rat_div_rat
  
  function rat__int_div_rat(int,this) !改动
    type(rational) :: rat__int_div_rat !改动
    integer,intent(in) :: int
    class(rational),intent(in) :: this !改动
    type(rational) :: temp !改动
    
    temp%denom = this%num !改动
    temp%num = this%denom * int !改动
    rat__int_div_rat = reduse(temp)
    
    return
  end function rat__int_div_rat
  
  function rat__rat_div_int(this,int) !改动
    type(rational) :: rat__rat_div_int !改动
    class(rational),intent(in) :: this !改动
    integer,intent(in) :: int
    type(rational) :: temp !改动
    
    temp%denom = this%denom * int !改动
    temp%num = this%num !改动
    rat__rat_div_int = reduse(temp)
    
    return
  end function rat__rat_div_int
  
  function rat__rat_exp_int(this,int) !改动
    type(rational) :: rat__rat_exp_int !改动
    class(rational),intent(in) :: this !改动
    integer,intent(in) :: int
    type(rational) :: temp !改动
    
    if(int >= 0)then
      temp%denom = this%denom ** int !改动
      temp%num = this%num ** int !改动
    else
      temp%denom = this%num ** (-int) !改动
      temp%num = this%denom ** (-int) !改动
    endif
    
    rat__rat_exp_int = reduse(temp)
    
    return
  end function rat__rat_exp_int

  subroutine input(this) !改动
    class(rational), intent(out) :: this !改动

    write(*,*) "分子:"
    read(*,*)  this%num !改动
    write(*,*) "分母:"
    read(*,*)  this%denom !改动
    
    if(this%denom <= 0) stop '报错：分母不为正数！' !改动

    return
  end subroutine input
  
  subroutine set(this,nn,dd) !构造函数
    class(rational), intent(out) :: this 
    integer, intent(in) :: nn,dd

    if(dd <= 0) stop '报错：分母不为正数'
    this%num = nn 
    this%denom = dd 
    
    return
  end subroutine set

  subroutine output(this)
    class(rational), intent(in) :: this !改动

    if ( this%denom /= 1 ) then
      write(*, "(' (',I3,'/',I3,')' )" ) this%num,this%denom !改动
    else
      write(*, "(I3)" ) this%num !改动
    end if

    return
  end subroutine output

end module rational_class

program main
  use rational_class
  implicit none
  
  type(rational) :: a,b,c

  call a%set(2,3) !改动
  call b%input() !改动

  write(*,*) "a="
  call a%output() !改动
  write(*,*) "b="
  call b%output() !改动
  
  c = 2 * a
  write(*,*) "2*a="
  call c%output() !改动
  c = b * (-2)
  write(*,*) "b*(-2)="
  call c%output() !改动8
  c = a / 2
  write(*,*) "a/2="
  call c%output() !改动
  c = a ** 2
  write(*,*) "a**2="
  call c%output() !改动
  c = a ** (-2)
  write(*,*) "a**(-2)="
  call c%output() !改动
  c = a + b
  write(*,*) "a+b="
  call c%output() !改动
  c = a - b
  write(*,*) "a-b="
  call c%output() !改动
  c = a * b
  write(*,*) "a*b="
  call c%output() !改动
  c = a / b
  write(*,*) "a/b="
  call c%output() !改动

  if (a > b) write(*,*) "a>b"
  if (a < b) write(*,*) "a<b"
  if (a >= b) write(*,*) "a>=b"
  if (a <= b) write(*,*) "a<=b"
  if (a == b) write(*,*) "a==b"
  if (a /= b) write(*,*) "a/=b"

  read(*,*)
end program main