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

[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 и уж, потом на этом основании строиться график. Чтобы узнать в какой день, что дуло нужно, чтобы ещё и на лучах насечки были с соответствующим днём?
Если так то по-моему сложновато! Помогите товарищи. Заранее спасибо. Почти ни разу не оставался без ответа и помощи на вашем форуме.

[klem4]

30 раз нужно будет ввести

Ну ввод уж точно из файла нужно сделать Интересная задача, когда тебе сдавать ?

[barlog]

Без файла никак нельзя? Просто там 40 с лишним задач на массивы, и парочка из них в виде зачётных. Вот "Роза ветров одна из них". Ну через недели две надеюсь. Я ещё по строкам кроссворд не сдал. Сможете помочь?! По "розе ветров".

[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 дает точно такую же картинку, проверил) в аттаче:

[barlog]

volvo ты просто молодец. Именно такой ввод нужен. А как можно будет узнавать когда и в каком направлении дул ветер? Что насечки с надписями выводить или что. Плиз допомогите. Спасибо.

[volvo]

А как можно будет узнавать когда и в каком направлении дул ветер?

А об этом, извини, в задании ничего не сказано. "Роза ветров" строится не для того, чтобы сказать, когда дул ветер на восток, а когда - на запад. Строится она с другой целью: узнать, куда ветра дуют чаще. Поэтому никакой информации о том, "когда ..." в "розе ветров" не содержится...

Направление совпадает с реальным - вверх: север, вниз - юг, и т. д... Можно выводить названия направлений в том же виде, в котором они описаны: "N", "S", "E", ... Если это тебе поможет - сделаю...

[barlog]

"в каком направлении дул ветер в соответствующий день месяца"-в условии задачи.
Я вроде бы когда показывал тот первый вариант который выложил здесь, мне что-то про дни преподаватель говорил. Ну просто если несложно или возможно помоги. В любом случае покажу два варианта. Спасибо.

[volvo]

В задании про другое:

В строке данных записаны 30 чисел от 1 до 8, показывающих, в каком направлении дул ветер в соответствующий день месяца

... Чувствуешь разницу? Это - данные... Они нигде не сохраняются. Ты их ввел, и ВСЁ, программа про них забыла. Ибо дальше:

Вывести на экран ”розу ветров”

- они не нужны... Нужно только количество дней, в которые дул соответствующий ветер...

В общем, с такими постановками задач и требованиями - разбирайся сам...

[barlog]

Да ты прав. Извини. Всё понял. Спасибо за помощь. Именно так и надо было как ты сделал. Ещё раз огромное спасибо!

[volvo]

Есть немного доработанная версия у меня на сайте... Можешь забрать оттуда:
Роза ветров

[barlog]

Извините, но это снова я.
Посмотрев твой вариант volvo сдал вот такой вот вариант.

uses graph,crt;

type
  Dir = (E,NE,N,NW,W,SW,S,SE);
  arrType = array[Dir] of integer;
const
  titles: array[Dir] of string = ('E','NE','N','NW','W','SW','S','SE');
  start  = ord(low(Dir));
  finish = ord(high(dir));
  amount = finish - start + 1;
  sector = (360 div amount) * (Pi / 180);
{--------------------------------------------------}
function read_data(var arr:arrType):integer;
var
  i,X,max:integer;
  ix:Dir;
begin
  for ix:=low(Dir) to
      high(Dir) do arr[ix]:=0;
  for i:=1 to 30 do begin
    read(X);
    if X <= 3 then X:=4-X else X:=12 - X;
    inc(arr[Dir(pred(X))]);
  end;
  max:=0;
  for ix:=low(Dir) to high(Dir) do
    if arr[ix]>max then max:=arr[ix];
  read_data:=max;
  readln;
end;
{--------------------------------------------------}
var  center_x, center_y:integer;
const  mult=20;
{--------------------------------------------------}
function get_x(r,phi:real):integer;
begin
  get_x:=center_x + trunc(mult * r * cos(phi));
end;
{--------------------------------------------------}
function get_y(r,phi:real):integer;
begin
  get_y:=center_y - trunc(mult * r * sin(phi));
end;
{--------------------------------------------------}
procedure line_polar(phi_st,r_st,phi_fn,r_fn:real);
begin
  line(
    get_x(r_st,phi_st), get_y(r_st,phi_st),
    get_x(r_fn,phi_fn), get_y(r_fn,phi_fn)
  );
end;
{--------------------------------------------------}
procedure text_polar(phi,r:real; const T:string);
begin
  outtextxy(get_x(r,phi), get_y(r,phi),T);
end;
{--------------------------------------------------}
procedure circle_polar(phi,r:real;radius:integer);
begin
  circle(get_x(r,phi), get_y(r,phi), mult*radius);
end;
{--------------------------------------------------}
var
  arr:arrType;
  i,j,max_val,gdriver,gmode:integer;

begin
  ClrScr;
  GotoXY(2,2); Writeln('N=1');
  GotoXY(2,3); Writeln('NE=2');
  GotoXY(2,4); Writeln('E=3');
  GotoXY(2,5); Writeln('SE=4');
  GotoXY(2,6); Writeln('S=5');
  GotoXY(2,7); Writeln('SW=6');
  GotoXY(2,8); Writeln('W=7');
  GotoXY(2,9); Writeln('NW=8');
  max_val := read_data(arr);
  initgraph(gDriver, gMode, 'd:\bp\bgi');
  center_x := getmaxx div 2;
  center_y := getmaxy div 2;
  for i := start to finish do begin
    setcolor(white);
    line_polar(0, 0, i * sector, 10);
    text_polar(i * sector, 11, titles[Dir(i)]);
    if i = finish then j := start else j := i + 1;
    setcolor(red);
    line_polar(i * sector, arr[Dir(i)], j * sector, arr[Dir(j)])
  end;
  setcolor(darkgray);
  for i := 1 to max_val do
    circle_polar(0, 0, i);
  readln;
  closegraph;
end.

Сказали что мол нельзя изменить количество направлений длая розы ветров. Т.е на 16 направлений и т.д
Т.е нужна универсальная программа. Помогите разобраться пожалуйстаю! Спасибо за помощь!

[barlog]

Volvo ПОМОГИ РАЗОБРАТЬСЯ ПОЖАЛУЙСТА С ЗАДАЧЕЙ.