2014 dxdy logo

Научный форум dxdy

Математика, Физика, Computer Science, Machine Learning, LaTeX, Механика и Техника, Химия,
Биология и Медицина, Экономика и Финансовая Математика, Гуманитарные науки




На страницу 1, 2  След.
 
 Помогите решить задачу по прогграммированию на Pascal
Сообщение26.05.2009, 18:17 
Заполните двумерный массив размером 7х7 числами от 1 до 49, расположив их в нем по спирали:
1 2 3 4 5 6 7
^ > > > > > > >8
^ ...............9
^ ..............10
21..............11
20..............12
19181716151413

 
 
 
 Re: Помогите решить задачу по прогграммированию на Pascal
Сообщение26.05.2009, 18:21 
Аватара пользователя
Возможно несколько вариантов решения. Например, самый ужасный - явно присвоить все ячейки. Так что лучше изложите свои идеи...

 
 
 
 Re: Помогите решить задачу по прогграммированию на Pascal
Сообщение31.05.2009, 17:13 
Как вариант:
Код:
const
  n = 7;
var
  mas : array[1..n,1..n] of integer;
  i, j, k, c, x, y : integer;
  r : real;
begin
  { заполняем массив }
  c := n;
  y := 1;
  k := 1;
  for i:= 1 to 2*n-1 do
  begin
    for j := 1 to c do
    begin
      x := x + round(cos(r));
      y := y + round(sin(r));
      mas[y,x] := k;
      inc(k);
    end;
    r := r + pi/2;
    if odd(i) then dec(c);
  end;
  { выводим массив }
  for i := 1 to n do
  begin
    for j := 1 to n do
      write(mas[i,j]:3);
    writeln;
  end;
end.

 
 
 
 Re: Помогите решить задачу по прогграммированию на Pascal
Сообщение20.06.2009, 11:24 
Код:
i:=1; j:=0; di:=0; dj:=1;
for k:=1 to n*n do
  begin
  if (i+di<1) or (n<i+di) or (j+dj<1) or (n<j+dj) or (a[i+di,j+dj]<>0) then
    begin t:=di; di:=dj; dj:=-t; end;
  i:=i+di; j:=j+dj; a[i,j]:=k;
  end;

 
 
 
 Re: Помогите решить задачу по прогграммированию на Pascal
Сообщение05.11.2009, 20:14 
Поясните пожалуйста решение agl7r
Ну или хотя бы объясните почему когда я пишу
Код:
r:=cos(pi/2);
writeln(r:4:4);
мне ничего не выдаёт. А в проограмме я так понял с помощью этого порядок ячеек задаётся.

 
 
 
 Re: Помогите решить задачу по прогграммированию на Pascal
Сообщение05.11.2009, 20:36 
tpc в сообщении #223487 писал(а):
Используется синтаксис Pascal
i:=1; j:=0; di:=0; dj:=1;
for k:=1 to n*n do
  begin
  if (i+di<1) or (n<i+di) or (j+dj<1) or (n<j+dj) or (a[i+di,j+dj]<>0) then
    begin t:=di; di:=dj; dj:=-t; end;
  i:=i+di; j:=j+dj; a[i,j]:=k;
  end;
 

Только, во-первых, сначала массив надо бы всё же обнулить (надеяться па автоинициалицию вроде и можно, но как-то некультурно). Во-вторых, примерно по тем же причинам надёжнее
Используется синтаксис Pascal
  rotat:=(i+di<1) or (n<i+di) or (j+dj<1) or (n<j+dj);
  if not rotat   then rotat:=a[i+di,j+dj]<>0;
  if rotat then begin . . . . . . . . .
 

(строго говоря, попытка обратиться к запрещённой области памяти бог весть к чему может привести).

-- Чт ноя 05, 2009 21:40:49 --

IBS в сообщении #258693 писал(а):
Ну или хотя бы объясните почему когда я пишу
Код:
r:=cos(pi/2);
writeln(r:4:4);
мне ничего не выдаёт.

Что значит "не выдаёт"? Ноль и выдаст. А зачем Вы это пишите?...

(автор таким экзотическим способом -- через синусы и косинусы -- решил организовать повороты на 90 градусов)

 
 
 
 Re: Помогите решить задачу по прогграммированию на Pascal
Сообщение06.11.2009, 23:20 
Аватара пользователя
ewert в сообщении #258702 писал(а):
(автор таким экзотическим способом -- через синусы и косинусы -- решил организовать повороты на 90 градусов)

Ага! Хорошо хоть в комплексную плоскость не перешёл и на $-i$ не начал умножать :)

Вообще задачка, конечно, простая. Нужно сначала обнулить массив, а затем идти по нему с шагом 1, заполняя нулевые ячейки положительными числами. Если встречается ненулевая ячейка или граница массива --- поворачивать на $90$ градусов по часовой стрелке.

-- Сб ноя 07, 2009 02:23:58 --

Маленькая подсказка: если вектор $(a,b)$ повернуть на $90$ градусов по часовой стрелке, то получится вектор $(b,-a)$.

 
 
 
 Re: Помогите решить задачу по прогграммированию на Pascal
Сообщение07.11.2009, 12:37 
Аватара пользователя
Вот нашел свою программу старую, может нужно еще:)
uses crt;
const n=12; m=19; sm:array[1..4,1..2] of integer=((0,1),(1,0),(0,-1),(-1,0));
var
a:array[0..n+1,0..m+1] of integer;
t,i,k,i1,k1,nap,q:integer;
begin
clrscr;
For i:=0 to n+1 do
For k:=0 to m+1 do a[i,k]:=1;
For i:=1 to n do
For k:=1 to m do a[i,k]:=0;
i:=1; k:=1; t:=0; nap:=1; q:=8;
repeat
inc(t); a[i,k]:=t; gotoxy(4*k,2*i); inc(q); If q=16 then q:=8;
textcolor(q); write(a[i,k]); delay(30000);
i1:=i+sm[nap,1]; k1:=k+sm[nap,2];
If a[i1,k1]<>0 then
begin
inc(nap);
If nap=5 then nap:=1;
i:=i+sm[nap,1]; k:=k+sm[nap,2];
end
else
begin
i:=i1; k:=k1;
end;
until t=n*m;
readkey;
end.

 
 
 
 Re: Помогите решить задачу по прогграммированию на Pascal
Сообщение07.11.2009, 14:44 
Сканирующая (построчная) генерация искомой матрицы:
код: [ скачать ] [ спрятать ]
Используется синтаксис Pascal
const Order=7;

var
    Top, Left: Byte;

    (* Just O(n) memory complexity. *)
    Row: array[1..Order] of Byte;

begin
    (* Generate all rows consecutively. *)
    for Top:=0 to Order-1 do
    begin
        (* Find values at the tips of the row. *)
        for Left:=1 to Top do
        begin
            (* Work on the left... *)
            Row[Left]:=
                3*Order-4*Left-2*Top+2
                +Row[Order-Left+1];
            (* ...and on the right. *)
            Inc(Row[Order-Left+1]);
        end;

        (* Fill up current row's interior. *)
        if Top <= Order div 2 then
            (* Walk left to right. *)
            for Left:=Top+1 to Order-Top do
                if Left=0 then
                    (* Prevent memory access troubles. *)
                    Row[1]:=1
                else
                    Row[Left]:=Row[Left-1]+1
        else
            (* Walk right to left. *)
            for Left:=Order-Top+1 to Top do
                Row[Left]:=Row[Left-1]-1;

        (* Now current row is ready. *)
        Yield(Row);
    end;
end.
 


Я, кажется, начал забывать паскаль, думал в строчек в пять уложусь...

 
 
 
 Re: Помогите решить задачу по прогграммированию на Pascal
Сообщение07.11.2009, 15:04 
Аватара пользователя
Эх, блин! Так хочется свой вариант сейчас взять и написать, а подруга из кухни кричит, чтоб немедлено шёл картошку чистить. Ну что за жизнь :(

 
 
 
 Re: Помогите решить задачу по прогграммированию на Pascal
Сообщение07.11.2009, 16:40 
Аватара пользователя
Так, картошка кончилась. Поехали...

код: [ скачать ] [ спрятать ]
Используется синтаксис Pascal
program Mine;
var A: array[1..7, 1..7] of integer;
      i,j,x.y,a,b: integer;
procedure rotate(var x,y: integer);
var z: integer:
begin
  z := x; x := y; y := -z
end;
begin
  for i := 1 to 7 do
    for j := 1 to 7 do A[i,j] := 0;
  x := 1; y := 0; a := 1; b := 1;
  for i := 1 to 49 do
    begin
      A[a,b] := i;
      if (a + x < 1) or (a + x > 7) or (b + y > 7) then rotate(x,y)
        else if A[a+x,b+y] > 0 then rotate(x,y);
      a := a + x; b := b + y
    end
end.

 
 
 
 Re: Помогите решить задачу по прогграммированию на Pascal
Сообщение07.11.2009, 16:49 
Плагиат:

tpc в сообщении #223487 писал(а):
<то же самое>

И ещё раз настоятельно рекомендую: последнее OR всё же лучше вынести в отдельный оператор. Хотя борландовский транслятор и обрывает (насколько я помню) проверку по достижении гарантированного результата, но в стандарт языка это вроде не входит, да и у самого Борланда (опять же насколько помню) эту опцию можно отключать.

 
 
 
 Re: Помогите решить задачу по прогграммированию на Pascal
Сообщение07.11.2009, 16:52 
Аватара пользователя
ewert в сообщении #259451 писал(а):
Плагиат

Да ну не плагиат, а очевидное, сразу напрашивающееся решение :?

Вы меня простите, товарищи программисты, я не писал програмки на паскале лет 10 :) Разве что для машины Тьюринга :)

-- Сб ноя 07, 2009 19:54:03 --

ewert в сообщении #259451 писал(а):
последнее OR всё же лучше вынести в отдельный оператор.

А смысл? Оптимизация по времени?

 
 
 
 Re: Помогите решить задачу по прогграммированию на Pascal
Сообщение07.11.2009, 16:54 
я совсем не программист, поэтому -- низачто непрощу!

 
 
 
 Re: Помогите решить задачу по прогграммированию на Pascal
Сообщение07.11.2009, 16:56 
Аватара пользователя
На самом деле там в проверке условия первые 4 сработают всего три первых раза, а затем начнёт работать последнее условие. Всё это можно расписать... Проверку $b + y < 1$ можно вообще убрать.

 
 
 [ Сообщений: 21 ]  На страницу 1, 2  След.


Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group