Pascal

Moderators: None (Apply to moderate this forum)
Number of threads: 4095
Number of posts: 14004

This Forum Only
Post New Thread
Single Post View       Linear View       Threaded View      f

Report
Geometry (cubes) Posted by ShadoWsaZ on 9 Mar 2009 at 8:59 AM
Hi there. I have a trouble with an algorithm. I need to divide 3D rectangle(I don't know how it is called in English) to cubes. How many cubes there will be trying to cut the biggest cube. There are a, b, c (dimensions) entered by the keyboard.
For example, I enter 2 3 5
program answers:
"2x2x2 2 cubes
1x1x1 14 cubes
At all 16 cubes."
There may not be functions or procedures, structural data types(arrays, records or sets).
Any help will be appreciated.
Report
Re: Geometry (cubes) Posted by Atex on 9 Mar 2009 at 2:19 PM
If I understood correctly:
program cubes;

const max_side=40; {40*40*40=64000 to fit a "word" type}

var a,b,c:byte;         {Sides of the hexahedron}
    v,j:word;           {Volume of the hexahedron}
    i:byte;
    ms:byte;            {smallest side}


begin
 repeat
  write('a= ');readln(a);
  write('b= ');readln(b);
  write('c= ');readln(c);
  writeln;
 until ((a in[1..max_side]) and (b in [1..max_side]) and (c in [i..max_side]));
 if a<b then ms:=a else ms:=b;  {find out smallest side}
 if c<ms then ms:=c;
 for i:=ms downto 1 do begin
  j:=(a div i) * (b div i) * (c div i);
  if j>1 then writeln(i,'x',i,'x',i,'   ',j,' cubes');
 end;
 writeln(#13#10,'Total   ',a*b*c,' cubes');
 readln;
end.

Report
Re: Geometry (cubes) Posted by ShadoWsaZ on 10 Mar 2009 at 7:42 AM
Sry for my bad English skills and being inaccurate. The program you have written is a bit different. I need to cut hexahedron into cubes trying to cut the biggest. I mean when program cuts two 2x2x2 cubes hexahedron changes (gets smaller). There are 14 cubes 1x1x1 after that.
For example, I have a=3; b=4; c=5.
First of all, program cuts 3x3x3 cube. Then the shape's which was hexahedron volume becomes 3x4x5-3x3x3 = 33. I mean it's changing. Then program cuts two 2x2x2 cubes. Volume becomes 33-2*8 = 17. In the end, program cuts 17 1x1x1 cubes.
With this a, b, c program should reply:
"
3x3x3 1 cubes
2x2x2 2 cubes
1x1x1 17 cubes
At all 20 cubes
"
As you see: 1*27 + 2*8 + 17*1 = a*b*c.
I hope it is clear now.
Report
Re: Geometry (cubes) Posted by Atex on 10 Mar 2009 at 10:27 AM
This complicates the situation, is no longer possible to solve with a few simple operations... see after you cut out the largest possible cube the remaining shape is not convex, so has to be divided into (the composing ) different convex shapes (hexahedrons )in order to be able to perform the next cut.(Unless is a simpler way to get around this) To do this without structures and subroutines (possible recursion) is quite hard... I could possibly put together a pseudo code for you, but I don't promote this kind of coding...
Report
Re: Geometry (cubes) Posted by ShadoWsaZ on 10 Mar 2009 at 1:11 PM
It is the task from a programming textbook for pupils. Given example to this task is with rectangle and squares:
program squares;
  var a, b,       { rectangle's dimensions }
      n,          { minimum number of squares }  
      k,          { number of same squares }
      x: integer;
begin
  n := 0;
  read(a, b);
  writeln('Given rectangle: ', a: 1, '*', b: 1);
  writeln('Squares: ');
  repeat
    if a < b then { change a with b }
      begin
        x := a;
        a := b;
        b := x
      end; { a >= b }
    k := a div b;
    a := a mod b;
    writeln(b: 15, '*', b: 1, k);
    n := n + k
  until (a = 0);
  writeln('Total number of squares: ', n: 4)
end.

But it is much easier :|
Report
Re: Geometry (cubes) Posted by Atex on 10 Mar 2009 at 8:45 PM
There you go, I was able to convert your 2D example into 3D, but this implementation has a structure and two subroutines and uses recursion. It is possible to go without all these of course, but like i said I don't like that kind of coding.
program cubes_v2;

const max_side=40;

var i,x,y,z:byte; { counter + sides of the hexahedron }
    v:array[1..max_side]  of word; { Structure to hold number of cut out cubes for each size }
    n:word; {no. of cubes cut}



procedure sort_(var a,b,c:byte); { Sorts 3 values in increasing order }
 procedure swap(var d,e:byte); { Swaps two values }
  begin
   d:=d xor e;                 { fast bitwise swap }
   e:=d xor e;
   d:=d xor e;
  end;
 begin
  if a>b then swap(a,b);
  if b>c then swap(b,c);
  if a>b then swap(a,b);
 end;

(*I realized, this algorithm doesn't work in all cases
procedure cutout_cube(a,b,c:byte);
 begin
  sort_(a,b,c);       { Sort sides, in increasing order, a = smallest                           }
  if a>0 then begin   { If a=0 then exit, no point slicing further                              }
   v[a]:=v[a]+((b div a)*(c div a)); { Calc. how many "a" sized squares are possible to cut out }
   cutout_cube(a,a,c mod a); {* Divide the remaining 3D "L" shape into two heaxahedrons         }
   cutout_cube(a,b mod a,c); {* Recursive call on both hexahedrons for further cube cutting     }
  end;
 end;
*)

procedure cutout_cube(trig:boolean;a,b,c:byte);
var x,y:word;
 begin
  sort_(a,b,c);       { Sort sides, in increasing order, a = smallest                           }
  if a>0 then begin   { If a=0 then exit, no point slicing further                              }
   x:=b div a;
   y:=c div a;;
   v[a]:=v[a]+x*y;
   if trig then begin
    cutout_cube(trig,a,a,c mod a);
    cutout_cube(trig,a,b mod a,c);
   end else begin
   if ((c mod a =0) and (y>0)) then cutout_cube(trig,a,c,b mod a) else
   if ((b mod a =0) and (x>0)) then cutout_cube(trig,a,b,c mod a) else
   begin
    cutout_cube(trig,a,a,b mod a);
    cutout_cube(trig,a,b,c mod a);
   end;
  end;end;
 end;

begin
 fillchar(v,sizeof(v),0); { init v with 0's, i.e. no cubes cut out }
 repeat
  write('x= ');readln(x);
  write('y= ');readln(y);
  write('z= ');readln(z);
  writeln;
 until ((x in[1..max_side]) and (y in[1..max_side]) and (z in[1..max_side]));
 sort_(x,y,z);
 cutout_cube(y=z,x,y,z);        { Start slicing }
 n:=0; {init n}
 for i:=max_side downto 1 do
  if v[i]>0 then begin 
   writeln(i,'x',i,'x',i,' cubes: ',v[i]); { Display cut out cubes }
   inc(n,v[i]);
  end;
 writeln(#13#10,'Total cubes : ',n);
 writeln(#13#10,'Total volume: ',word(x*y*z)); { Display total 1x1x1 cubers ( volume ) }
 readln;
end.

Report
Re: Geometry (cubes) Posted by Phat Nat on 10 Mar 2009 at 9:55 PM
I'm guessing he figured it's impossible since you need some sort of way of holding the two cubes once you split one, however he never mentioned using the stack ;)

Done with no functions, arrays or sets! Enjoy!
{$mode tp}
{$asmmode intel}
program squares;
  var a, b, c,    { rectangle's dimensions }
      n,          { minimum number of squares }
      small,
      large : Integer;
      cSm,
      cLr,
      temp1,
      temp2,
      temp3  : integer;
      count : integer;
begin
  n := 0;  { Number of cubes made. Set to zero to start }

  WriteLn;
  Write('Enter 3D cube size seperated by spaces : ');
  ReadLn(a,b,c);
  writeln('Given rectangle: ', a: 1, 'x', b: 1, 'x', c: 1);
  writeln('Squares: ');

  count := a*b*c;   { Our total number of 1x1x1 squares }

  { We will put these here for saftey! don't want stack issues... }
  asm mov ax, $FFFF; push ax; push ax; push ax; end;

  repeat
        { Find our smallest side }
        If (a <= b) and (a <= c) then
        Begin
           Small := a;
           cSm := 1;
        End
        ELSE
        If (b <= a) and (b <= c) then
        Begin
           Small := b;
           cSm := 2;
        End
        ELSE
        If (c <= a) and (c <= b) then
        Begin
           Small := c;
           cSm := 3;
        End;

        { Find our largest side }
        If (a >= b) and (a >= c) then
        Begin
           Large := a;
           cLr := 1;
        End
        ELSE
        If (b >= a) and (b >= c) then
        Begin
           Large := b;
           cLr := 2;
        End
        ELSE
        If (c >= a) and (c >= b) then
        Begin
           Large := c;
           cLr := 3;
        End;
        { A cube of our smallest side can be made }
        WriteLn(Small,'x',Small,'x',Small);
        { Update our count of remaining 1x1x1 cubes }
        count := count - (Small*Small*Small);
        { Increase our count of total cubes made }
        inc(n);

        { When a cube is removed, we will be left with two cubes. We just
          have to figure out their sizes... }
        If Small < Large Then
        Case cSm Of
         1 :Begin
                 If cLr = 2 Then
                 Begin
                      Temp1 := b-a;
                      Temp3 := b-Temp1;
                      Temp2 := c-a;
                      ASM
                         { Leftover smaller cube }
                         Push a;
                         Push Temp3;
                         Push Temp2;
                         { Leftover larger cube }
                         Push a;
                         Push Temp1;
                         Push c;
                      End;
                 End
                 Else
                 Begin
                      Temp1 := c-a;
                      Temp3 := c-Temp1;
                      Temp2 := b-a;
                      ASM
                         { Leftover smaller cube }
                         Push a;
                         Push Temp2;
                         Push Temp3;
                         { Leftover larger cube }
                         Push a;
                         Push b;
                         Push Temp1;
                      End;
                 End
            End;
         2 :Begin
                 If cLr = 1 Then
                 Begin
                      Temp1 := a-b;
                      Temp3 := a-Temp1;
                      Temp2 := c-b;
                      ASM
                         { Leftover smaller cube }
                         Push Temp3;
                         Push b;
                         Push Temp2;
                         { Leftover larger cube }
                         Push Temp1;
                         Push b;
                         Push c;
                      End;
                 End
                 Else
                 Begin
                      Temp1 := c-b;
                      Temp3 := c-Temp1;
                      Temp2 := a-b;
                      ASM
                         { Leftover smaller cube }
                         Push Temp2;
                         Push b;
                         Push Temp3;
                         { Leftover larger cube }
                         Push a;
                         Push b;
                         Push Temp1;
                      End;
                 End
            End;
         3 :Begin
                 If cLr = 1 Then
                 Begin
                      Temp1 := a-c;
                      Temp3 := a-Temp1;
                      Temp2 := b-c;
                      ASM
                         { Leftover smaller cube }
                         Push Temp3;
                         Push Temp2;
                         Push c;
                         { Leftover larger cube }
                         Push Temp1;
                         Push b;
                         Push c;
                      End;
                 End
                 Else
                 Begin
                      Temp1 := b-c;
                      Temp3 := b-Temp1;
                      Temp2 := a-c;
                      ASM
                         { Leftover smaller cube }
                         Push Temp2;
                         Push Temp3;
                         Push c;
                         { Leftover larger cube }
                         Push a;
                         Push Temp1;
                         Push c;
                      End;
                 End
            End;
        End;
        asm
          @again:
           { get next cube from stack for processing }
           pop c
           pop b
           pop a

           { For safety incase something goes wrong }
           cmp a, -1
           jne @next
           mov count, 0
           jmp @done
          @next:
           { if any one of the sides is 0, it's not a real cube so discard }
           cmp a, 0
           je @again
           cmp b, 0
           je @again
           cmp c, 0
           je @again
          @done:
        end;
  until (count = 0);
  writeln('Total number of squares: ', n: 4)
end.
Report
Re: Geometry (cubes) Posted by ShadoWsaZ on 11 Mar 2009 at 8:54 AM
I am wondering if there is a simple version of this algorithm. Program should not be much harder than the program of example.
However, Atex your program gets into trouble with x = 3; y = 5; z = 2.
Phat Nat I was not able to compile your program with FP IDE.
Anyway, thank you guys for helping me :)
Report
Re: Geometry (cubes) Posted by Atex on 11 Mar 2009 at 9:12 PM
This should work:
program cubes_v3;
uses crt;

const max_side=40;

var i,x,y,z:byte; { counter + sides of the hexahedron }
    v:array[1..max_side]  of word; { Structure to hold number of cut out cubes for each size }
    n:word; {no. of cubes cut}


procedure swap(var d,e:byte); { Swaps two values }
 begin
  d:=d xor e;                 { fast bitwise swap }
  e:=d xor e;
  d:=d xor e;
 end;

procedure cutout_cube_(a,b,c:byte);
 begin
  if a>b then swap(a,b);
  if b>c then swap(b,c);
  if a>b then swap(a,b);
  case a of
   0:exit;
   1:v[a]:=v[a]+b*c;
   else begin
   v[a]:=v[a]+((b div a)*(c div a));
   if ((c mod a)<(b mod a)) then swap(b,c);
   if ((c mod a=0) or (b mod a=0)) then begin
    cutout_cube_(a,c,b mod a);
    cutout_cube_(a,b,c mod a);
   end else
   begin
     cutout_cube_(a,b,c mod a);
     cutout_cube_(a,a * (c div a),b mod a);
   end;
   end;
  end;
 end;

var ch:char;

begin
 repeat
  fillchar(v,sizeof(v),0); { init v with 0's, i.e. no cubes cut out }
  n:=0;                    { init n }
   repeat
    write('x= ');readln(x);
    write('y= ');readln(y);
    write('z= ');readln(z);
    writeln;
   until ((x in[2..max_side]) and (y in[2..max_side]) and (z in[2..max_side]));

  cutout_cube_(x,y,z);

  for i:=max_side downto 1 do
   if v[i]>0 then begin
    writeln(#32,i,'x',i,'x',i,' cubes: ',v[i]:5); { Display cut out cubes }
    inc(n,v[i]);
   end;
  writeln(#13#10,'Total cubes : ',n:5);
  writeln(#13#10,'Press Esc to exit, any key to continue',#13#10);
  ch:=readkey;
 until ch=#27;
end.
Also, for FP, try to include {$mode tp} and {$ asmmode intel} as the first two lines, to force FP to compile in TP compatible mode and to use intel's dialect for ASM.
Report
Re: Geometry (cubes) Posted by ShadoWsaZ on 12 Mar 2009 at 2:20 AM
I realized that there can be the problem cutting two hexahedrons after the cube had been cut off. For example with x = 9; y = 11; z = 12; program gives bad results (too many 1x1x1, too less 2x2x2).

Oh.. I have skipped that two lines copying :)
Report
Re: Geometry (cubes) Posted by Phat Nat on 12 Mar 2009 at 6:37 PM
What's the correct result for 9x11x12? I get 93 cubes.
I don't bother counting how many of each. It lists them. It could be done, but I was going for the whole no procedure/sets/arrays thing.
Either way, it's terrible coding. Done way faster and shorter code using a recursive function ;)
Report
Re: Geometry (cubes) Posted by Atex on 14 Mar 2009 at 12:30 AM
Try to test this:
procedure cutout_cube_(a,b,c:byte);
 begin
  if a>b then swap(a,b);
  if b>c then swap(b,c);
  if a>b then swap(a,b);
  case a of
   0:exit;
   1:v[a]:=v[a]+b*c;
   else begin
   v[a]:=v[a]+((b div a)*(c div a));
   if (c mod a=0) then cutout_cube_(a,c,b mod a) else
   if (b mod a=0) then cutout_cube_(a,b,c mod a) else
   begin
   if ((c mod a)>=(b mod a)) then begin
     if ((a * ( b div a )) mod (c mod a))=0 then swap(b,c);
     cutout_cube_(a,a * (c div a),b mod a);
     cutout_cube_(a,b,c mod a);
   end else begin
     if ((a * ( c div a )) mod (b mod a))=0 then swap(b,c);
     cutout_cube_(a,a * (b div a),c mod a);
     cutout_cube_(a,c,b mod a);
   end;
   end;
   end;
  end;
 end;
It is correct with: (2,3,5), (3,4,5), (3,5,5), (9,11,12), (x,x,x), but could be some combinations when the splitting won't be optimized ( like 9,11,12 with the previous algorithm ).
In comparison with the 2D situation the 3D problem is much more complicated. The algorithm first will cut out a cube equal to the smallest size of the hexahedron, the remaining 3D "L" shape must be split in 2 hexahedrons so more (smaller) cubes could be cut out. The split can happen is two ways, where the algorithm must choose the case with the more bigger cube yield. For example, with the 9,11,12 solid, in the first step a 9x9x9 cube is removed leaving the following shape:
       12
    OOOOOOOOOOOO
    OOOOOOOOOOOO
    OOO
    OOO
    OOO   
11  OOO     ( 9 deep )
    OOO
    OOO      O = 1x1x1 cube
    OOO
    OOO
    OOO
This can be split in 2 ways:
1:                                2:

    OOOOOOOOOOOO  12x2x9             OOO  OOOOOOOOO  9x2x9  
    OOOOOOOOOOOO                     OOO  OOOOOOOOO
                                     OOO
    OOO    3x9x9                     OOO    3x11x9
    OOO                              OOO
    OOO                              OOO
    OOO                              OOO
    OOO    ( 9 deep )                OOO    ( 9 deep )
    OOO                              OOO
    OOO                              OOO
    OOO                              OOO
    OOO
One could expect that 2 choice would be better since could yield more bigger cubes, it is usually true for most situations. But in this case the 3x3x3 yield is the same for both ways, so choosing 1 results in more 2x2x2 cubes than 2, therefore more efficient. See, by adding an extra dimension the problem deepens logarithmically , imagine what nightmare would it be working with a hypercube...
Report
Re: Geometry (cubes) Posted by ShadoWsaZ on 16 Mar 2009 at 12:51 AM
With my tests it works perfectly. It is clear how it is done, thank you ;)



 

Recent Jobs