Fortran Coder

标题: 值日分配安排问题的逻辑 [打印本页]
作者: 306908677    时间: 2014-11-29 09:38
标题: 值日分配安排问题的逻辑
先试求出次数，使用递归程序试了好多种，最后发现都有逻辑错误＝＝ 还没办法改，请大牛指点一下这个程序的逻辑该怎么写－－＃
[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
×
×
√
×
×
√
√
为保证每名同学一周之内必须值日一天，请编写程序计算所有合理的安排方案的个数，并将所有的安排方案打印在屏幕上。   


作者: 百事可乐    时间: 2014-11-29 10:36
我愣是没看懂楼主的需求？要实现什么呢？建议楼主再详细描述一下。

PS：楼主那七段 if  if  call  完全可以用 do  循环实现的。
作者: 306908677    时间: 2014-11-29 10:57
本帖最后由 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


作者: 306908677    时间: 2014-11-29 10:59
百事可乐 发表于 2014-11-29 10:36
我愣是没看懂楼主的需求？要实现什么呢？建议楼主再详细描述一下。

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

＝＝修改了一下＝＝
作者: 百事可乐    时间: 2014-11-29 11:56
本帖最后由 百事可乐 于 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
作者: 306908677    时间: 2014-11-29 12:31
百事可乐 发表于 2014-11-29 11:56
我觉得吧,你不应该对 lg 数组进行修改.这是原始数据啊....输出的时候，也不应该输出 lg

下面的代码不知道 ...

实在太感谢你了！
看完发现原来可以用all来判断一行（19 ( all(arr(1:iDay)/=i) ) & ! 且以前没安排过该人）
一直在找其他复杂的写法替代。。。
还有看完你的代码发现代码真的是有美丑之分的，真是学习了！！＝＝
再次感谢～



欢迎光临 Fortran Coder (http://bbs.fcode.cn/) Powered by Discuz! X3.2