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

weixing1531

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


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

weixing1531

源代码如下

[Fortran] 纯文本查看 复制代码

查看代码

打印?

001	module rational_class

002	implicit none

003

private

004

005	type,public :: rational !分数类

006

private

007

008	integer :: num    ! 分子

009	integer :: denom  ! 分母

010

contains

011

private

012

! 加法+

013	procedure,pass(this) :: rat__rat_plus_rat,rat__int_plus_rat,rat__rat_plus_int

014	generic,public :: operator(+) => rat__rat_plus_rat,rat__int_plus_rat,rat__rat_plus_int

015

! 减法-

016	procedure,pass(this) :: rat__rat_minus_rat,rat__int_minus_rat,rat__rat_minus_int

017	generic,public :: operator(-) => rat__rat_minus_rat,rat__int_minus_rat,rat__rat_minus_int

018

! 乘法*

019	procedure,pass(this) :: rat__rat_times_rat,rat__int_times_rat,rat__rat_times_int

020	generic,public :: operator(*) => rat__rat_times_rat,rat__int_times_rat,rat__rat_times_int

021

! 除法/

022	procedure,pass(this) :: rat__rat_div_rat,rat__int_div_rat,rat__rat_div_int

023	generic,public :: operator(/) => rat__rat_div_rat,rat__int_div_rat,rat__rat_div_int

024

! 乘方**

025	procedure,pass(this) :: rat__rat_exp_int

026	generic,public :: operator(**) => rat__rat_exp_int

027

! 赋值=

028	procedure,pass(this) :: rat_eq_rat,int_eq_rat,real_eq_rat,rat_eq_int

029	generic,public :: assignment(=) => rat_eq_rat,int_eq_rat,real_eq_rat,rat_eq_int

030

! 大于>

031	procedure,pass(this) :: rat_gt_rat,int_gt_rat,rat_gt_int

032	generic,public :: operator(>) => rat_gt_rat,int_gt_rat,rat_gt_int

033

! 小于<

034	procedure,pass(this) :: rat_lt_rat,int_lt_rat,rat_lt_int

035	generic,public :: operator(<) => rat_lt_rat,int_lt_rat,rat_lt_int

036

! 等于==

037	procedure,pass(this) :: rat_compare_rat,int_compare_rat,rat_compare_int

038	generic,public :: operator(==) => rat_compare_rat,int_compare_rat,rat_compare_int

039

! 不等于/=

040	procedure,pass(this) :: rat_ne_rat,int_ne_rat,rat_ne_int

041	generic,public :: operator(/=) => rat_ne_rat,int_ne_rat,rat_ne_int

042

! >=

043	procedure,pass(this) :: rat_ge_rat,int_ge_rat,rat_ge_int

044	generic,public :: operator(>=) => rat_ge_rat,int_ge_rat,rat_ge_int

045

! <=

046	procedure,pass(this) :: rat_le_rat,int_le_rat,rat_le_int

047	generic,public :: operator(<=) => rat_le_rat,int_le_rat,rat_le_int

048

049	procedure,pass(this),public :: output,input,set

050	end type rational

051

contains

052

! 分数>分数

053	function rat_gt_rat(this,b)  !改动

054	logical :: rat_gt_rat

055	class(rational), intent(in) :: this,b !改动

056	type(rational) :: fa  !改动

057

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

059

060	if (fa%num > 0)then !差值的分子大于0

061	rat_gt_rat = .true.

062

else

063	rat_gt_rat = .false.

064

end if

065

066

return

067	end function rat_gt_rat

068

! 整数>分数

069	function int_gt_rat(a,this)  !改动

070	logical :: int_gt_rat

071	integer,intent(in) :: a

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

073	type(rational) :: fa  !改动

074

075	fa = (a - this)

076

077	if (fa%num > 0)then !差值的分子大于0

078	int_gt_rat = .true.

079

else

080	int_gt_rat = .false.

081

end if

082

083

return

084	end function int_gt_rat

085

! 分数>整数

086	function rat_gt_int(this,b)  !改动

087	logical :: rat_gt_int

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

089	integer,intent(in) :: b

090	type(rational) :: fa  !改动

091

092	fa = (this - b)  !改动

093

094	if (fa%num > 0)then !差值的分子大于0

095	rat_gt_int = .true.

096

else

097	rat_gt_int = .false.

098

end if

099

100

return

101	end function rat_gt_int

102

! 分数<分数

103	function rat_lt_rat(this,b)  !改动

104	logical :: rat_lt_rat

105	class(rational), intent(in) :: this,b  !改动

106

!利用等价

107	rat_lt_rat = rat_gt_rat(b,this) !利用现有函数

108

109

return

110	end function rat_lt_rat

111

! 整数<分数

112	function int_lt_rat(a,this)  !改动

113	logical :: int_lt_rat

114	integer,intent(in) :: a

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

116

!利用等价

117	int_lt_rat = rat_gt_int(this,a) !利用现有函数

118

119

return

120	end function int_lt_rat

121

! 分数<整数

122	function rat_lt_int(this,b)  !改动

123	logical :: rat_lt_int

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

125	integer,intent(in) :: b

126

!利用等价

127	rat_lt_int = int_gt_rat(b,this) !利用现有函数

128

129

return

130	end function rat_lt_int

131

! 分数==分数

132	function rat_compare_rat(this,b)  !改动

133	logical :: rat_compare_rat

134	class(rational), intent(in) :: this,b  !改动

135	type(rational) :: c  !改动

136

137	c = (this - b)  !改动

138

139	if ( c%num == 0 ) then !差值的分子等于0

140	rat_compare_rat = .true.

141

else

142	rat_compare_rat = .false.

143

end if

144

145

return

146	end function rat_compare_rat

147

! 整数==分数

148	function int_compare_rat(a,this)  !改动

149	logical :: int_compare_rat

150	integer,intent(in) :: a

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

152

!利用等价

153	int_compare_rat = rat_compare_int(this,a) !利用现有函数

154

155

return

156	end function int_compare_rat

157

! 分数==整数

158	function rat_compare_int(this,b)  !改动

159	logical :: rat_compare_int

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

161	integer,intent(in) :: b

162	type(rational) :: c !改动

163

164	c = (this - b)  !改动

165

166	if ( c%num == 0 ) then !差值的分子等于0

167	rat_compare_int = .true.

168

else

169	rat_compare_int = .false.

170

end if

171

172

return

173	end function rat_compare_int

174

! 分数/=分数

175	function rat_ne_rat(this,b)  !改动

176	logical :: rat_ne_rat

177	class(rational), intent(in) :: this,b  !改动

178

179	rat_ne_rat = .not.rat_compare_rat(this,b) !利用现有函数

180

181

return

182	end function rat_ne_rat

183

! 整数/=分数

184	function int_ne_rat(a,this)  !改动

185	logical :: int_ne_rat

186	integer,intent(in) :: a

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

188

189	int_ne_rat = .not.int_compare_rat(a,this) !利用现有函数

190

191

return

192	end function int_ne_rat

193

! 分数/=整数

194	function rat_ne_int(this,b)  !改动

195	logical :: rat_ne_int

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

197	integer,intent(in) :: b

198

199	rat_ne_int = .not.rat_compare_int(this,b) !利用现有函数

200

201

return

202	end function rat_ne_int

203

! 分数>=分数

204	function rat_ge_rat(this,b)  !改动

205	logical :: rat_ge_rat

206	class(rational), intent(in) :: this,b !改动

207

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

209

210

return

211	end function rat_ge_rat

212

! 整数>=分数

213	function int_ge_rat(a,this)  !改动

214	logical :: int_ge_rat

215	integer,intent(in) :: a

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

217

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

219

220

return

221	end function int_ge_rat

222

! 分数>=整数

223	function rat_ge_int(this,b)  !改动

224	logical :: rat_ge_int

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

226	integer,intent(in) :: b

227

228	rat_ge_int = rat_gt_int(this,b) .or. rat_compare_int(this,b) !利用现有函?

229

230

return

231	end function rat_ge_int

232

! 分数<=分数

233	function rat_le_rat(this,b)  !改动

234	logical :: rat_le_rat

235	class(rational), intent(in) :: this,b !改动

236

!利用等价

237	rat_le_rat = rat_ge_rat(b,this) !利用现有函数

238

239

return

240	end function rat_le_rat

241

! 整数<=分数

242	function int_le_rat(a,this)  !改动

243	logical :: int_le_rat

244	integer,intent(in) :: a

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

246

!利用等价

247	int_le_rat = rat_ge_int(this,a) !利用现有函数

248

249

return

250	end function int_le_rat

251

! 分数<=整数

252	function rat_le_int(this,b)  !改动

253	logical :: rat_le_int

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

255	integer,intent(in) :: b

256

!利用等价

257	rat_le_int = int_ge_rat(b,this) !利用现有函数

258

259

return

260	end function rat_le_int

261

! 分数=分数

262	subroutine rat_eq_rat( rat1, this ) !改动

263	class(rational), intent(out) :: rat1 !改动

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

265

266	rat1%num   = this%num

267	rat1%denom = this%denom

268

269

return

270	end subroutine rat_eq_rat

271

! 整数=分数

272	subroutine int_eq_rat( int, this )  !改动

273	integer, intent(out) :: int

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

275

276	int = this%num / this%denom

277

278

return

279	end subroutine int_eq_rat

280

! 分数=整数

281	subroutine rat_eq_int( this, int )  !改动

282	integer, intent(in) :: int

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

284

285	this%num = int

286	this%denom = 1

287

288

return

289	end subroutine rat_eq_int

290

! 浮点数=分数

291	subroutine real_eq_rat( float, this ) !改动

292	real, intent(out) :: float

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

294

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

296

297

return

298	end subroutine real_eq_rat

weixing1531

[Fortran] 纯文本查看 复制代码

查看代码

打印?

001

! 化简分数

002	function reduse( a )

003	type(rational), intent(in) :: a

004	type(rational) :: temp

005	integer :: b

006	integer :: sign

007	type(rational) :: reduse

008

009	if ( a%num*a%denom > 0 ) then !同号

010

sign=1

011

else !异号

012

sign=-1

013

end if

014

015	temp%num=abs(a%num) !取分子绝对值

016	temp%denom=abs(a%denom) !取分母绝对值

017	b=gcv(temp%num,temp%denom)  ! 找正分子与正分母的最大公因数

018	! 把正分子,正分母同除以最大公因数

019	reduse%num = temp%num/b*sign

020	reduse%denom = temp%denom/b !保证约分后分母仍为正数

021

022

return

023	end function reduse

024	! 用辗转相除法找最大公因数

025	function gcv(a,b)

026	integer, intent(in) :: a,b

027	integer :: big,small

028	integer :: temp

029	integer :: gcv

030

031	big=max(a,b)

032	small=min(a,b)

033

034	do while( small>1 )

035	temp=mod(big,small)

036	if ( temp == 0 ) exit

037

big=small

038	small=temp

039

end do

040

041

gcv=small

042

return

043	end function gcv

044

045	function rat__rat_plus_rat( this, rat2 ) !改动

046	type(rational) :: rat__rat_plus_rat

047	class(rational), intent(in) :: this,rat2 !改动

048	type(rational) :: act

049

050	act%denom = this%denom * rat2%denom !改动  公分母

051	act%num  = this%num * rat2%denom + rat2%num * this%denom !改动

052	rat__rat_plus_rat = reduse(act)

053

054

return

055	end function rat__rat_plus_rat

056

057	function rat__int_plus_rat(int,this) !改动

058	type(rational) :: rat__int_plus_rat !改动

059	integer,intent(in) :: int

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

061

!加法交换律

062	rat__int_plus_rat = rat__rat_plus_int(this,int) !利用现有函数

063

064

return

065	end function rat__int_plus_rat

066

067	function rat__rat_plus_int(this,int) !改动

068	type(rational) :: rat__rat_plus_int !改动

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

070	integer,intent(in) :: int

071	type(rational) :: act !改动

072

073	act%denom = this%denom !改动

074	act%num = this%denom * int + this%num !改动

075	rat__rat_plus_int = reduse(act)

076

077

return

078	end function rat__rat_plus_int

079

080	function rat__rat_minus_rat( this, rat2 ) !改动

081	type(rational) :: rat__rat_minus_rat

082	class(rational), intent(in) :: this, rat2 !改动

083	type(rational) :: temp

084

085	temp%denom = this%denom * rat2%denom !改动  公分母

086	temp%num   = this%num * rat2%denom - rat2%num * this%denom !改动

087	rat__rat_minus_rat = reduse( temp )

088

089

return

090	end function rat__rat_minus_rat

091

092	function rat__int_minus_rat(int,this) !改动

093	type(rational) :: rat__int_minus_rat !改动

094	integer,intent(in) :: int

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

096	type(rational) :: temp !改动

097

098	temp%denom = this%denom !改动

099	temp%num = this%denom * int - this%num !改动

100	rat__int_minus_rat = reduse(temp)

101

102

return

103	end function rat__int_minus_rat

104

105	function rat__rat_minus_int(this,int) !改动

106	type(rational) :: rat__rat_minus_int !改动

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

108	integer,intent(in) :: int

109	!a-b=a+(-b)

110	rat__rat_minus_int = rat__rat_plus_int(this,-int) !利用现有函数

111

112

return

113	end function rat__rat_minus_int

114

115	function rat__rat_times_rat( this, rat2 ) !改动

116	type(rational) :: rat__rat_times_rat

117	class(rational), intent(in) :: this, rat2 !改动

118	type(rational) :: temp

119

120	temp%denom = this%denom* rat2%denom !改动

121	temp%num   = this%num  * rat2%num !改动

122	rat__rat_times_rat = reduse(temp)

123

124

return

125	end function rat__rat_times_rat

126

127	function rat__int_times_rat(int,this) !改动

128	type(rational) :: rat__int_times_rat !改动

129	integer,intent(in) :: int

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

131

!乘法交换律

132	rat__int_times_rat=rat__rat_times_int(this,int)  !利用现有函数

133

134

return

135	end function rat__int_times_rat

136

137	function rat__rat_times_int(this,int) !改动

138	type(rational) :: rat__rat_times_int !改动

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

140	integer,intent(in) :: int

141	type(rational) :: temp !改动

142

143	temp%denom = this%denom !改动

144	temp%num = this%num * int !改动

145	rat__rat_times_int = reduse(temp)

146

147

return

148	end function rat__rat_times_int

149

150	function rat__rat_div_rat( this, rat2 ) !改动

151	type(rational) :: rat__rat_div_rat

152	class(rational), intent(in) :: this, rat2 !改动

153	type(rational) :: temp

154

155	temp%denom = this%denom * rat2%num !改动

156	temp%num   = this%num  * rat2%denom !改动

157	rat__rat_div_rat = reduse(temp)

158

159

return

160	end function rat__rat_div_rat

161

162	function rat__int_div_rat(int,this) !改动

163	type(rational) :: rat__int_div_rat !改动

164	integer,intent(in) :: int

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

166	type(rational) :: temp !改动

167

168	temp%denom = this%num !改动

169	temp%num = this%denom * int !改动

170	rat__int_div_rat = reduse(temp)

171

172

return

173	end function rat__int_div_rat

174

175	function rat__rat_div_int(this,int) !改动

176	type(rational) :: rat__rat_div_int !改动

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

178	integer,intent(in) :: int

179	type(rational) :: temp !改动

180

181	temp%denom = this%denom * int !改动

182	temp%num = this%num !改动

183	rat__rat_div_int = reduse(temp)

184

185

return

186	end function rat__rat_div_int

187

188	function rat__rat_exp_int(this,int) !改动

189	type(rational) :: rat__rat_exp_int !改动

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

191	integer,intent(in) :: int

192	type(rational) :: temp !改动

193

194	if(int >= 0)then

195	temp%denom = this%denom ** int !改动

196	temp%num = this%num ** int !改动

197

else

198	temp%denom = this%num ** (-int) !改动

199	temp%num = this%denom ** (-int) !改动

200

endif

201

202	rat__rat_exp_int = reduse(temp)

203

204

return

205	end function rat__rat_exp_int

206

207	subroutine input(this) !改动

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

209

210	write(*,*) "分子:"

211	read(*,*)  this%num !改动

212	write(*,*) "分母:"

213	read(*,*)  this%denom !改动

214

215	if(this%denom <= 0) stop '报错：分母不为正数！' !改动

216

217

return

218	end subroutine input

219

220	subroutine set(this,nn,dd) !构造函数

221	class(rational), intent(out) :: this

222	integer, intent(in) :: nn,dd

223

224	if(dd <= 0) stop '报错：分母不为正数'

225	this%num = nn

226	this%denom = dd

227

228

return

229	end subroutine set

230

231	subroutine output(this)

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

233

234	if ( this%denom /= 1 ) then

235	write(*, "(' (',I3,'/',I3,')' )" ) this%num,this%denom !改动

236

else

237	write(*, "(I3)" ) this%num !改动

238

end if

239

240

return

241	end subroutine output

242

243	end module rational_class

244

245	program main

246	use rational_class

247	implicit none

248

249	type(rational) :: a,b,c

250

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

252	call b%input() !改动

253

254	write(*,*) "a="

255	call a%output() !改动

256	write(*,*) "b="

257	call b%output() !改动

258

259

c = 2 * a

260	write(*,*) "2*a="

261	call c%output() !改动

262	c = b * (-2)

263	write(*,*) "b*(-2)="

264	call c%output() !改动8

265

c = a / 2

266	write(*,*) "a/2="

267	call c%output() !改动

268	c = a ** 2

269	write(*,*) "a**2="

270	call c%output() !改动

271	c = a ** (-2)

272	write(*,*) "a**(-2)="

273	call c%output() !改动

274

c = a + b

275	write(*,*) "a+b="

276	call c%output() !改动

277

c = a - b

278	write(*,*) "a-b="

279	call c%output() !改动

280

c = a * b

281	write(*,*) "a*b="

282	call c%output() !改动

283

c = a / b

284	write(*,*) "a/b="

285	call c%output() !改动

286

287	if (a > b) write(*,*) "a>b"

288	if (a < b) write(*,*) "a<b"

289	if (a >= b) write(*,*) "a>=b"

290	if (a <= b) write(*,*) "a<=b"

291	if (a == b) write(*,*) "a==b"

292	if (a /= b) write(*,*) "a/=b"

293

294

read(*,*)

295	end program main