Determine all integers m for which a square of length m can be dissected into five rectangles, the side lengths of which are the integers 1,2,3,...,10 in some order.
There are many candidate solutions where the ariel sum of 5 pieces add to a square, 14 candidates for 121, 9 for 144, and 12 for 169. Of these, only 2 for 121 and 2 for 169 can be fit together to a square. Note, any one map is one of eight rotations and/or reflections. The candidates, 4 maps and the program are shown.
program sq
implicit none
integer i01,i02,i03,i04,i05,i06,i07,i08,i09,i10,
1 area,iarea,iarearoot,a1,a2,a3,a4,a5,nq(3),nnq,aq(3),aq2(3),
2 q(2,2,5,14,3),i169(12,2,10),c(3),j(2,2,10),gr(13,13),
3 i,i2,i3,i5,ll2,kk2,k1,k2,k3,k4,k5,k(5),c5,
4 kk5,mc,m1,m2,m3,m4,m5,m(5),mm5,posn(5,32),f(5,120),
5 s,a,p,row,col,hei,wid,tw,th,ir,ic,cfree,rfree,top,side
data nq/14,9,12/,aq/11,12,13/,aq2/121,144,169/,c/3*0/
top=5
c
c j( [1 w, 2 h], [1 w<h, 2 w>h], [rect 1 to 5] )
c q ( [ j (2,2,5) ], [14 max num of 5 piece combos], [3 sq areas] )
c
i01=1
do 2 i02=2,10
if(i01.eq.i02)go to 2
a1=i01*i02
j(1,1,1)=i01
j(2,1,1)=i02
j(1,2,1)=i02
j(2,2,1)=i01
do 3 i03=2,10
if(i01.eq.i03.or.i02.eq.i03)go to 3
do 4 i04=i03+1,10
if(i01.eq.i04.or.i02.eq.i04.or.i03.eq.i04)go to 4
a2=i03*i04
j(1,1,2)=i03
j(2,1,2)=i04
j(1,2,2)=i04
j(2,2,2)=i03
do 5 i05=i03+1,10
if(i01.eq.i05.or.i02.eq.i05.or.i03.eq.i05.or.i04.eq.i05)
1 go to 5
do 6 i06=i05+1,10
if(i01.eq.i06.or.i02.eq.i06.or.i03.eq.i06.or.i04.eq.i06.or.
1 i05.eq.i06)go to 6
a3=i05*i06
j(1,1,3)=i05
j(2,1,3)=i06
j(1,2,3)=i06
j(2,2,3)=i05
do 7 i07=i05+1,10
if(i01.eq.i07.or.i02.eq.i07.or.i03.eq.i07.or.i04.eq.i07.or.
1 i05.eq.i07.or.i06.eq.i07)go to 7
do 8 i08=i07+1,10
if(i01.eq.i08.or.i02.eq.i08.or.i03.eq.i08.or.i04.eq.i08.or.
1 i05.eq.i08.or.i06.eq.i08.or.i07.eq.i08)go to 8
a4=i07*i08
j(1,1,4)=i07
j(2,1,4)=i08
j(1,2,4)=i08
j(2,2,4)=i07
do 9 i09=i07+1,9
if(i01.eq.i09.or.i02.eq.i09.or.i03.eq.i09.or.i04.eq.i09.or.
1 i05.eq.i09.or.i06.eq.i09.or.i07.eq.i09.or.i08.eq.i09)go to 9
do 10 i10=i09+1,10
if(i01.eq.i10.or.i02.eq.i10.or.i03.eq.i10.or.i04.eq.i10.or.
1 i05.eq.i10.or.i06.eq.i10.or.i07.eq.i10.or.i08.eq.i10.or.
2 i09.eq.i10)go to 10
a5=i09*i10
j(1,1,5)=i09
j(2,1,5)=i10
j(1,2,5)=i10
j(2,2,5)=i09
area=a1+a2+a3+a4+a5
iarearoot=sqrt(1.*area)
iarea=iarearoot**2
if(area.eq.iarea)then
c print 88,area,i01,i02,i03,i04,i05,i06,i07,i08,i09,i10
c88 format(i3,3x,5('(',i2,',',i2,') '))
do i3=1,3
if(iarea.eq.aq2(i3))then
i=i3
c(i)=c(i)+1
go to 200
endif
enddo
print*,'unknown square area'
stop
200 continue
do ll2=1,2
do kk2=1,2
do i5=1,5
q(ll2,kk2,i5,c(i),i)=j(ll2,kk2,i5)
enddo
enddo
enddo
c print 1001,area,c(i),((q(ll2,1,i5,c(i),i),ll2=1,2),i5=1,5)
1001 format(i3,2x,i2,5(3x,i2,',',i2))
c print 1002, ((q(ll2,2,i5,c(i),i),ll2=1,2),i5=1,5)
1002 format(7x, 5(3x,i2,',',i2),/)
endif
10 continue
9 continue
8 continue
7 continue
6 continue
5 continue
4 continue
3 continue
2 continue
do i=1,3
do nnq=1,nq(i)
print 888,aq2(i),nnq,((q(i2,1,i5,nnq,i),i2=1,2),i5=1,5)
888 format('area = ',i3,x,'index = ',i2,x,5('(',i2,',',i2,') '))
enddo
enddo
c5=0
do 11 k1=1,5
k(1)=k1
do 22 k2=1,5
if(k1.eq.k2)go to 22
k(2)=k2
do 33 k3=1,5
if(k1.eq.k3.or.k2.eq.k3)go to 33
k(3)=k3
do 44 k4=1,5
if(k1.eq.k4.or.k2.eq.k4.or.k3.eq.k4)go to 44
k(4)=k4
do 55 k5=1,5
if(k1.eq.k5.or.k2.eq.k5.or.k3.eq.k5.or.
1 k4.eq.k5)go to 55
k(5)=k5
c5=c5+1
do kk5=1,5
f(kk5,c5)=k(kk5)
enddo
c print 1003,c5,(f(kk5,c5),kk5=1,5)
1003 format(i3,2x,5(i1,1x))
55 enddo
44 enddo
33 enddo
22 enddo
11 enddo
c print*,'number of 5 piece orders = ',c5
mc=0
do m1=1,2
m(1)=m1
do m2=1,2
m(2)=m2
do m3=1,2
m(3)=m3
do m4=1,2
m(4)=m4
do m5=1,2
m(5)=m5
mc=mc+1
do mm5=1,5
posn(mm5,mc)=m(mm5)
enddo
c print 1004,mc,(posn(mm5,mc),mm5=1,5)
1004 format(i2,3x,5(1x,i1))
enddo
enddo
enddo
enddo
enddo
c print*,'num of posn patterns = ',mc
do i=1,3
do s=1,nq(i)
do a=1,120
do 555 p=1,32
do row=1,aq(i)
do col=1,aq(i)
gr(col,row)=0
enddo
enddo
do i5=1,top
c print*,' i5 = ',i5
c
c find first open cell for the next piece
c
|
Posted by Steven Lord
on 2020-10-03 12:21:36 |