Fortran Coder

查看: 7614|回复: 5
打印 上一主题 下一主题

[通用算法] 值日分配安排问题的逻辑

[复制链接]

22

帖子

6

主题

0

精华

入门

StarkLee

F 币
96 元
贡献
52 点
跳转到指定楼层
楼主
发表于 2014-11-29 09:38:14 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
先试求出次数,使用递归程序试了好多种,最后发现都有逻辑错误== 还没办法改,请大牛指点一下这个程序的逻辑该怎么写--#
[Fortran] 纯文本查看 复制代码
program main
implicit none
integer r,k,m
integer n
logical :: pe(7,7) = reshape( ((/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0&
,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/)==1) , (/7,7/) )
logical :: lg(7,7) = reshape( ((/0,1,0,0,1,0,0,1,0,0,0,0,1,0,0,0,1,0,0,0,1,1,0,0,0,1,0,0,0,0,0,1,0,1&
,0,0,1,0,0,1,0,1,0,0,1,0,0,0,1/)==1) , (/7,7/) )
n=7
m=0
k=1
call sub1(k,n,m)
print *,m

contains 
recursive subroutine sub1(k,n,m)
implicit none
integer n,k,i,r,q,m
        if (lg(k,1).and.k<8)        then
        lg(k,1)=.false.
        k=k+1
                if(k==7)then
                m=m+1
                end if
        call sub1(k,n,m)
        end if
        if (lg(k,2).and.k<8)        then
        lg(k,2)=.false.
        k=k+1
                if(k==7)then
                m=m+1
                end if
        call sub1(k,n,m)
        end if
        if (lg(k,3).and.k<8)        then
        lg(k,3)=.false.
        k=k+1
                if(k==7)then
                m=m+1
                end if
        call sub1(k,n,m)
        end if
        if (lg(k,4).and.k<8)        then
        lg(k,4)=.false.
        k=k+1
                if(k==7)then
                m=m+1
                end if
        call sub1(k,n,m)
        end if
        if (lg(k,5).and.k<8)        then
        lg(k,5)=.false.
        k=k+1
                if(k==7)then
                m=m+1
                end if
        call sub1(k,n,m)
        end if
        if (lg(k,6).and.k<8)        then
        lg(k,6)=.false.
        k=k+1
                if(k==7)then
                m=m+1
                end if
        call sub1(k,n,m)
        end if
        if (lg(k,7).and.k<8)        then
        lg(k,7)=.false.
        k=k+1
                if(k==7)then
                m=m+1
                end if
        call sub1(k,n,m)
        end if

end subroutine
end program main


周一
周二
周三
周四
周五
周六
周日
同学1
×
×
×
×
×
  
同学2
  
  
  
  
×
  
  
×
  
  
×
  
  
×
  
  
  
  
×
  
同学3
×
×
×
×
×
  
同学4
  
  
×
  
  
×
  
  
×
  
  
×
  
  
  
  
×
  
  
×
  
同学5
×
×
×
×
  
同学6
  
  
×
  
  
  
  
×
  
  
×
  
  
  
  
×
  
  
×
  
同学7
×
×
×
×
为保证每名同学一周之内必须值日一天,请编写程序计算所有合理的安排方案的个数,并将所有的安排方案打印在屏幕上。   


分享到:  微信微信
收藏收藏 点赞点赞 点踩点踩

100

帖子

0

主题

0

精华

专家

F 币
550 元
贡献
291 点

规矩勋章元老勋章

QQ
沙发
发表于 2014-11-29 10:36:55 | 只看该作者
我愣是没看懂楼主的需求?要实现什么呢?建议楼主再详细描述一下。

PS:楼主那七段 if  if  call  完全可以用 do  循环实现的。

22

帖子

6

主题

0

精华

入门

StarkLee

F 币
96 元
贡献
52 点
板凳
 楼主| 发表于 2014-11-29 10:57:38 | 只看该作者
本帖最后由 306908677 于 2014-11-29 11:00 编辑

3. 有7个同学轮流值日,为了和其他任务不冲突,各人将有空的天数罗列成表:

        周一        周二        周三        周四        周五        周六        周日
同学1        ×        √        ×        √        ×        ×        ×
同学2        √        ×        ×        ×        ×        √        ×
同学3        ×        ×        √        ×        ×        ×        √
同学4        ×        ×        ×        ×        √        ×        ×
同学5        √        ×        ×        √        ×        √        ×
同学6        ×        √        ×        ×        √        ×        ×
同学7        ×        ×        √        ×        ×        √        √
为保证每名同学一周之内必须值日一天,请编写程序计算所有合理的安排方案的个数,并将所有的安排方案打印在屏幕上。(共15分)(本题记分,请找老师检查)

我先试着写算出安排方案==
用了do循环==还是不对诶
[Fortran] 纯文本查看 复制代码
program main
implicit none
integer r,k,m
integer n
logical :: pe(7,7) = reshape( ((/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0&
,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/)==1) , (/7,7/) )
logical :: lg(7,7) = reshape( ((/0,1,0,0,1,0,0,1,0,0,0,0,1,0,0,0,1,0,0,0,1,1,0,0,0,1,0,0,0,0,0,1,0,1&
,0,0,1,0,0,1,0,1,0,0,1,0,0,0,1/)==1) , (/7,7/) )
n=7
m=0
k=1
call sub1(k,n,m)
print *,m

contains 
recursive subroutine sub1(k,n,m)
implicit none
integer n,k,i,r,q,m
do i=1,n
	if (lg(k,i).and.k<8)	then
	lg(k,i)=.false.
	k=k+1
		if(k==7)then
		m=m+1
		write(*,"(7l1//7l1//7l1//7l1)") ((lg(r,q),q=1,7),r=1,7)
		k=1
		else
		call sub1(k,n,m)
		end if
	end if
end do
end subroutine
end program main


22

帖子

6

主题

0

精华

入门

StarkLee

F 币
96 元
贡献
52 点
地板
 楼主| 发表于 2014-11-29 10:59:20 | 只看该作者
百事可乐 发表于 2014-11-29 10:36
我愣是没看懂楼主的需求?要实现什么呢?建议楼主再详细描述一下。

PS:楼主那七段 if  if  call  完全可 ...

==修改了一下==

100

帖子

0

主题

0

精华

专家

F 币
550 元
贡献
291 点

规矩勋章元老勋章

QQ
5#
发表于 2014-11-29 11:56:12 | 只看该作者
本帖最后由 百事可乐 于 2014-11-29 12:02 编辑

我觉得吧,你不应该对 lg 数组进行修改.这是原始数据啊....输出的时候,也不应该输出 lg

下面的代码不知道是不是你想要的意思?

[Fortran] 纯文本查看 复制代码
program main
  implicit none
  Integer , parameter :: NDay = 7 ! 7 天
  Integer , parameter :: NMan = 7 ! 7 个人
  logical :: bIdle(NMan,NDay) = reshape( ((/0,1,0,0,1,0,0,1,0,0,0,0,1,0,0,0,1,0,0,0,1,1,0,0,0,1,0,0,0,0,0,1,0,1&
  ,0,0,1,0,0,1,0,1,0,0,1,0,0,0,1/)==1) , (/NMan,NDay/) )
  integer :: arrange(NDay) , nArrg = 0  ! 当前的安排,有效的安排个数
  arrange(:) = 0
  call sub1( arrange , 1 ) ! 安排第一天
  print * , nArrg
contains 
  recursive subroutine sub1( arr , iDay )
    implicit none
    integer , intent( IN ) :: iDay
    integer , intent( INOUT ) :: arr(:)
    integer :: i
    Do i = 1 , NMan
     if ( bIdle(i,iDay) .and. & ! 如果该人该天有空 
        ( all(arr(1:iDay)/=i) ) & ! 且以前没安排过该人
        ) then
        arr(iDay) = i ! 当天安排该人
        If ( iDay < NDay ) then  ! 如果没安排完
          call sub1( arr , iDay+1) ! 安排下一天
        Else ! 否则安排完了
          write(*,"(7i2)") arr(:) ! 输出
          nArrg = nArrg + 1 ! 合理安排个数 + 1
        End If
        arr(iDay) = 0 ! 取消该天安排,以便列举安排其他人的情况
      end if
    End Do
  end subroutine
  
end program main


输出 4 种安排,每一行表示一种安排,7个数字代表7天,每个数字表示该天由几号学生值日。
2 6 3 1 4 5 7
2 6 7 1 4 5 3
5 6 3 1 4 2 7
5 6 7 1 4 2 3
           4

评分

参与人数 2F 币 +18 贡献 +18 收起 理由
306908677 + 9 + 9 赞一个!
fcode + 9 + 9 赞一个!

查看全部评分

22

帖子

6

主题

0

精华

入门

StarkLee

F 币
96 元
贡献
52 点
6#
 楼主| 发表于 2014-11-29 12:31:58 | 只看该作者
百事可乐 发表于 2014-11-29 11:56
我觉得吧,你不应该对 lg 数组进行修改.这是原始数据啊....输出的时候,也不应该输出 lg

下面的代码不知道 ...

实在太感谢你了!
看完发现原来可以用all来判断一行(19 ( all(arr(1:iDay)/=i) ) & ! 且以前没安排过该人)
一直在找其他复杂的写法替代。。。
还有看完你的代码发现代码真的是有美丑之分的,真是学习了!!==
再次感谢~
您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

捐赠本站|Archiver|关于我们 About Us|小黑屋|Fcode ( 京ICP备18005632-2号 )

GMT+8, 2024-11-1 06:57

Powered by Tencent X3.4

© 2013-2024 Tencent

快速回复 返回顶部 返回列表