论坛 › Fortran算法研究 › 彭国伦书中派生分数类型的扩展

weixing1531 发表于 2018-11-19 14:24:32

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

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


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

weixing1531 发表于 2018-11-19 14:26:28

本帖最后由 weixing1531 于 2018-11-19 14:30 编辑

源代码如下
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 发表于 2018-11-19 14:29:10

本帖最后由 weixing1531 于 2018-11-19 14:38 编辑

! 化简分数
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

查看完整版本: 彭国伦书中派生分数类型的扩展