Роза ветров, Задача на одномерный массив Опции

[barlog]

В строке данных записаны 30 чисел от 1 до 8, показывающих, в каком направлении дул ветер в соответствующий день месяца (1-северный, 2-северо-восточный, 3-восточный, 4-юго-воточный, 5 южный, 6-юго-западный, 7-западный, 8-северо-западный).
Вывести на экран ”розу ветров” - многоугольник, вершинами которого лежат на 8-лучах, выходящих из общего центра с равным углами, расстояния от вершины до этого центра пропорционально дней месяца, в который дул соответствующий ветер.

Нашёл программу примера ”розы ветров”.

Вот она... (Показать/Скрыть)

uses crt, graph;


type Napr_N=1..8;
    Koord=1..2;

var
  Napr:Napr_N;
  Napr_text:string[16];
  data:array[Napr_N] of word;
  Karta:array[Napr_N,Koord] of real;{Koord=1 - ось X, Koord=2 - ось Y}
  Xmin,Xmax,Ymin,Ymax:real;
  Simvol:char;

{процедура ввода чисел в массив}
Procedure input;
var i: integer;

begin
    TextColor(yellow);
    TextBackGround(blue);
    clrscr;
    for Napr:=1 to 8 do  {Ввод чисел, каждое - сила ветра}
                         {по одному из восьми направлений}
              begin
                   case Napr of  {Выбор одного направления ветра}
                        1:Napr_text:='восточного';
                        2:Napr_text:='северо-восточного';
                        3:Napr_text:='северного';
                        4:Napr_text:='северо-западного';
                        5:Napr_text:='западного';
                        6:Napr_text:='юго-западного';
                        7:Napr_text:='южного';
                        8:Napr_text:='юго-восточного'
                   end;
                   {Ввод и проверка числа дней с выбранным направлением ветра}
                   repeat
                         TextColor(white);
                         write('Сила ',Napr_text,' ветра: ');
                         TextColor(lightred);
                       readln(data[Napr]);
                       clrscr;
                 until data[Napr]>=0;
end;
end;

{просчет пропорций области карты}
procedure Oblast;
         var
            Koeff:real;
begin
    Koeff:=Sqrt(2)/2; {Коэффициент для промежуточных направлений ветра}
    for Napr:=1 to 8 do
        begin
             case Napr of
                  1:begin Karta[Napr,1]:=data[Napr];
                          Karta[Napr,2]:=0 end;
                  2:begin Karta[Napr,1]:=data[Napr]*Koeff;
                          Karta[Napr,2]:=Karta[Napr,1] end;
                  3:begin Karta[Napr,1]:=0;
                          Karta[Napr,2]:=data[Napr] end;
                  4:begin Karta[Napr,1]:=-data[Napr]*Koeff;
                          Karta[Napr,2]:=-Karta[Napr,1] end;
                  5:begin Karta[Napr,1]:=-data[Napr];
                          Karta[Napr,2]:=0 end;
                  6:begin Karta[Napr,1]:=-data[Napr]*Koeff;
                          Karta[Napr,2]:=Karta[Napr,1] end;
                  7:begin Karta[Napr,1]:=0;
                          Karta[Napr,2]:=-data[Napr] end;
                  8:begin Karta[Napr,1]:=data[Napr]*Koeff;
                          Karta[Napr,2]:=-Karta[Napr,1] end
             end;
        end;
    Xmin:=Karta[1,1]; Xmax:=Karta[1,1];
    Ymin:=Karta[1,2]; Ymax:=Karta[1,2];
    for Napr:=2 to 8 do
        begin
             if Karta[Napr,1]<Xmin then Xmin:=Karta[Napr,1];
             if Karta[Napr,1]>Xmax then Xmax:=Karta[Napr,1];
             if Karta[Napr,2]<Ymin then Ymin:=Karta[Napr,2];
             if Karta[Napr,2]>Ymax then Ymax:=Karta[Napr,2];
        end;
    if (Xmin=Xmax) or (Ymin=Ymax) then
       begin
            writeln('С этими данными график не построить -');
            writeln('Xmin=',Xmin:0:2,' Xmax=',Xmax:0:2,' Ymin=',Ymin:0:2,' Ymax=',Ymax:0:2);
            writeln('Попробуйте использовать другие значения');
            halt;
       end;
    writeln; TextColor(yellow);
    writeln('Область графика: ',Xmin:0:2,'<=X<=',Xmax:0:2,';', Ymin:0:2,'<=Y<=',Ymax:0:2);
    writeln; TextColor(white);
    writeln('Здесь учтен коэффициент, равный SQRT(2)/2 для направлений:');
    writeln('северо-восток, северо-запад, юго-запад, юго-восток');
    writeln;
    write('Если Вас устраивает область графика, нажмите клавишу 1 и <Enter> ');
    readln(Simvol);
    if Simvol<>'1' then
                    begin
                         writeln('Готовьте новые значения переменных и',
                                ' запускайте программу. Желаем успехов.');
                         readln;
                         halt
                    end;
end;

{построение графика}

procedure Grafik;
         var
            Driver,Mode,Code_error:integer;
            X0,Y0:integer;
            Coords:array[Napr_N,Koord] of word;
            Mx,My,M:real;
begin

    Driver:=Detect; {Автоопределяющийся тип драйвера}
    InitGraph(driver,mode,'d:\bp\bgi'); {Файл Graph.tpu - в текущем каталоге ('')}
    if GraphResult <>0 then writeln(GraphErrorMsg(Code_error));

    {Определение масштабного множителя М=min(Mx,My)}
    Mx:=(GetMaxX-30)/(Xmax-Xmin);    {15 - отступ по оси X от края окна}
    My:=(GetMaxY-20)/(Ymax-Ymin);    {10 - отступ по оси Y от края окна}
    if Mx<My then M:=Mx else M:=My;
    SetBkColor(black);

    {Определение местонахождения точки (Х0,У0) - начала координат}
    X0:=round(-Xmin*M+(GetMaxX-(Xmax-Xmin)*M)/2);
    Y0:=round(Ymax*M+(GetMaxY-(Ymax-Ymin)*M)/2);
    SetLineStyle(0,3,2);
    SetColor(green);
    Coords[1,1]:=X0+round(Karta[1,1]*M);
    Coords[1,2]:=Y0-round(Karta[1,2]*M);
    MoveTo(Coords[1,1],Coords[1,2]);
    for Napr:= 2 to 8 do
         begin
              Coords[Napr,1]:=X0+round(Karta[Napr,1]*M);
              Coords[Napr,2]:=Y0-round(Karta[Napr,2]*M);
              {Проводим отрезок прямой от текущего указателя до точки Napr}
              LineTo(Coords[Napr,1],Coords[Napr,2])
         end;
    LineTo(Coords[1,1],Coords[1,2]); {Замыкаем ломаную}
    SetFillStyle(11,lightred);
    FloodFill(X0,Y0,green);
    SetColor(white);
    SetLineStyle(0,0,1);
    Line(0,Y0,GetMaxX-10,Y0); OutTextXY(GetMaxX-15,Y0-3,'>');
    Line(X0,4,X0,GetMaxY); OutTextXY(X0-3,1,'^');
    SetTextStyle(2,0,0);
    OutTextXY(GetMaxX-25,Y0+6,'X');
    OutTextXY(X0-12,1,'Y');
    OutTextXY(X0-12,Y0+6,'0');
    SetColor(yellow);
    SetLineStyle(3,0,1);
    Napr:=2;
    repeat
          Line(X0,Y0,Coords[Napr,1],Coords[Napr,2]);
          Napr:=Napr+2;
    until Napr>8;
    {Надписи сторон света}
    SetTextStyle(3,HorizDir,1);
    OutTextXY(10,Y0-10,'West');
    OutTextXY(GetMaxX-40,Y0-10,'East');
    SetTextStyle(3,VertDir,1);
    OutTextXY(X0-5,10,'North');
    OutTextXY(X0-5,GetMaxY-40,'South');
    SetViewPort(10,5,130,55,ClipOn);
    SetColor(green);
    SetTextStyle(DefaultFont,HorizDir,1);
    SetTextJustify(CenterText,CenterText);
    {OutTextXY(60,15,'Р О З А');
    OutTextXY(60,30,'В Е Т Р О В');  }
readln;
end;

{main}

begin
    repeat
          input;       {Ввод исходных данных}
          Oblast;      {Нахождение границ области графика, преобр.координат}
          Grafik;      {Построение графика}
          readln;
          RestoreCrtMode; {Временный выход в текстовый режим работы монитора}
          readln;
          TextBackGround(blue);
          TextColor(yellow);
          ClrScr; GoToXY(15,10);
          write('Повторить c начала? Да - введите 1 и нажмите <Enter> ');
          readln(Simvol)
    until Simvol <> '1';
    CloseGraph;
    TextMode(Co40);
    TextBackGround(white); TextColor(magenta);
    Window(2,5,39,19);
    ClrScr; GoToXY(4,7);
    writeln('...press a key to exit...');
    ReadKey;
end.

Хотел сдать в таком виде, но преподаватель сказал, что не полностью выполняется условия поставленной задачи. И она, по-моему, очень уж громоздкая. Помогите, пожалуйста. Т.е 30 раз нужно будет ввести числа от 1 до 8 и уж, потом на этом основании строиться график. Чтобы узнать в какой день, что дуло нужно, чтобы ещё и на лучах насечки были с соответствующим днём?
Если так то по-моему сложновато! Помогите товарищи. Заранее спасибо. Почти ни разу не оставался без ответа и помощи на вашем форуме.

[volvo]

Ну, вот что-то такое:
(это без оптимизации, можно еще "причесать" код программы, добавить пару функций, код будет выглядеть гораздо красивее)

uses graph;

type
  Dir = (
    N, NE, E, SE, S, SW, W, NW
  );
  arrType = array[Dir] of integer;


procedure read_data(var arr: arrType);
var
  i, X: integer;
  ix: Dir;
begin

  for ix := low(Dir) to
      high(Dir) do arr[ix] := 0;

  for i := 1 to 30 do begin
    read(X);
    inc(arr[Dir(pred(X))]);
  end;
  readln;

end;

procedure line_polar(phi_st, r_st, phi_fn, r_fn: real);
const mult = 25;
begin
  line(
    (getmaxx div 2) + trunc(mult * r_st*cos(phi_st)),
    (getmaxy div 2) - trunc(mult * r_st*sin(phi_st)),
    (getmaxx div 2) + trunc(mult * r_fn*cos(phi_fn)),
    (getmaxy div 2) - trunc(mult * r_fn*sin(phi_fn))
  );
end;



var
  arr: arrType;
  i, j, start, finish, amount: integer;

  gDriver, gMode, errCode: integer;

begin
  read_data(arr);

  initgraph(gDriver, gMode, '');
  errCode := graphresult;
  if errCode <> grOk then begin
    writeln('error: ', grapherrormsg(errCode));
    readln; halt(100);
  end;


  start := ord(low(Dir));
  finish := ord(high(dir));
  amount := finish - start + 1;

  for i := 1 to 2 do begin
    j := arr[Dir(start)];
    move(arr[Dir(start + 1)], arr[Dir(start)], (amount - 1) * sizeof(j));
    arr[Dir(finish)] := j;
  end;

  for i := start to finish do begin
    setcolor(white);
    line_polar(0, 0, i * (360 div amount) * (Pi / 180), 10);

    if i = finish then j := start else j := i + 1;
    setcolor(red);
    line_polar(i * (360 div amount) * (Pi / 180), arr[Dir(i)],
               j * (360 div amount) * (Pi / 180), arr[Dir(j)])
  end;

  readln;
  closegraph;
end.

Проверял вот с такими данными (вводишь в одну строку, жмешь Enter):

1 2 3 4 5 6 7 8 1 2 2 2 2 3 4 5 5 4 2 6 5 5 3 4 7 1 1 2 3 4

Результат - (отработал, правда в FPC, но и TP дает точно такую же картинку, проверил) в аттаче: