LINUX.ORG.RU

Pascal

 ,


0

1

Добрый день, товарищи форумчане. Может кто скажет, что я делаю не так? По заданию нужно отсортировать телефоны методом вставок из файла. Вот понимаю, что не должно быть сложным, но что-то торможу.

program lab1_1;
var
   Arrx : array[1..25] of char;
   Arr  : array[1..10, 1..25] of char;
   i, j, k     : longint;
   x, y    : integer;
begin
     assign(input, 'in.txt');
     reset(input);
     assign(output, 'result.txt');
     rewrite(output);

     for i := 1 to 10 do
     begin
          for j := 1 to 25 do
          begin
               read(Arr[i, j]);
               write(Arr[i, j]);
          end;
          readln; writeln;
     end;
     writeln;
      writeln('Sort numbers: ');
      for k:=1 to 25 do begin
  for j := 16 to 25 do
     begin
  for i := 2 to 10 do
begin
  if Arr[i-1,  j] <= Arr[i, j] then
  begin
  Arrx[k]:= Arr[i-1, j];
  Arr[i-1, j] := Arr[i, j];
  Arr[i, j]  := Arrx[k];
 end;
        end;
        end;
        end;
  write(Arr);
     close(input);
     close(output);     
       end.  

Pascal давно вышел из употребления и нет смысла его применять. Поэтому например вашу программу трудно проверить - надо искать транслятор, но лень. Я знаю Pascal, но хоть каждый оператор в программе понятен, непонятна ваша проблема - что не получается? Как вы пытаетесь решить задачу? Например

Arr : array[1..10, 1..25] of char;

Это наверно исходный массив из 25 телефонных номеров по 10 цифр в каждом. Но что значит 16 в операторе

for j := 16 to 25 do

не могу связать это с вашими номерами.

Partisan ★★★ ()

Обновил код. Теперь он, конечно, сортирует номера. Вот только эти самые номера от зачем-то собирает из всех чисел сам.

KrasnoGlazik ()

Давайте начнём с полного текста задания.
Затем, не забудем указать ограничения, вроде формата исходных данных, неиспользования собственных процедур/функций, хранения строк в массиве символов и другой подобной чуши.

PS. Более подходящим местом для обсуждения может оказаться:
http://www.cyberforum.ru/pascal/ или даже
http://www.cyberforum.ru/turbo-pascal/

bormant ★★★★★ ()
Ответ на: комментарий от KrasnoGlazik

Такие задачи решают студенты за бесплатно :-(

Ну так и иди к этим студентам. Сюда зачем пришёл? Сам не можешь решить детскую задачу, а нахер обществу такой «специалист»? Чтобы потом спутники тонули? Даже нормально отформатировать код не удосужился.

korvin_ ★★★★★ ()

Будем есть слона частями...

Чтение и вывод исходных:

const nmax=10;
type TLine = array [0..25] of Char;
var
  a: array [1..nmax] of Char;
  n: Integer;
begin
  Assign(input,'in.txt'); Reset(input);
  Assign(output,'result.txt'); Rewrite(output);
  {n:=0;}
  while (n<nmax) and not EoF do begin
    ReadLn(a[n]); WriteLn(a[n]);
  end;
  {...}
  Close(input); Close(output);
end.

Сравнение:
function IsLess(const a, b: TLine): Boolean;
var j: Integer;
begin
  IsLess:=False;
  for j:=16 to 24 do
    if a<b then begin
      IsLess:=True; Exit;
    end else if a>b then Exit;
end;

Сортировка и вывод результата:
var
  t: TLine;
  i, j: Integer;
...
  for i:=2 to n do begin
    t:=a[i]; j:=i;
    while (j>1) and IsLess(t,a[j-1]) do begin
      a[j]:=a[j-1]; Dec(j);
    end;
    a[j]:=t;
  end;

  WriteLn; WriteLn('Sorted:');
  for i:=1 to n do WriteLn(a[i]);

bormant ★★★★★ ()
Последнее исправление: bormant (всего исправлений: 1)
Ответ на: комментарий от KrasnoGlazik

Я прошу тыкнуть в мою ошибку.

ты просишь проанализировать простыню кода, установить ошибку, локализовать её и разжевать тебе

это не учитывая, что их там больше одной может быть, вплоть до того момента, когда их количество станет измеряться не в штуках, а в процентах от размера кода

MyTrooName ★★★★★ ()
Последнее исправление: MyTrooName (всего исправлений: 2)
Ответ на: комментарий от KrasnoGlazik

не прошу решить. Я прошу тыкнуть в мою ошибку.

Увы, многократно проще решить, чем тыкать во все ошибки, что там есть...

bormant ★★★★★ ()
Ответ на: комментарий от bormant

В виде процедуры сортировка могла быть такой:

procedure InsSort(var a: array of TLine; n: Integer);
var
  t: TLine;
  i, j: Integer;
begin
  for i:=1 to n-1 do begin
    t:=a[i]; j:=i;
    while (j>0) and IsLess(t,a[j-1]) do begin
      a[j]:=a[j-1]; Dec(j);
    end;
    a[j]:=t;
  end;
end;

bormant ★★★★★ ()

Писать код нужно в расчете на то, что сопровождать его будет склонный к насилию психопат, который точно знает, где вы живете. (q)

bormant ★★★★★ ()
Ответ на: комментарий от bormant

А если нужно позволить сортировать одной процедурой по разным критериям, то такой:

type LessFunc = function (const a, b: TLine): Boolean;

procedure InsSort(var a: array of TLine; n: Integer; IsLess: LessFunc);
var
  t: TLine;
  i, j: Integer;
begin
  for i:=1 to n-1 do begin
    t:=a[i]; j:=i;
    while (j>0) and IsLess(t,a[j-1]) do begin
      a[j]:=a[j-1]; Dec(j);
    end;
    a[j]:=t;
  end;
end;

procedure IsLess(const a, b: TLine; l, r: Integer): Boolean;
begin
  IsLess:=False;
  for l:=l to r do
    if a[l]<b[l] then begin
      IsLess:=True; Exit;
    end else if a[l]>b[l] then Exit;
end;

function ByPhone(const a, b: TLine): Boolean; far;
begin
  ByPhone:=IsLess(a,b,16,24);
end;

function ByName(const a, b: TLine): Boolean; far;
begin
  ByName:=IsLess(a,b,0,15);
end;
...
  InsSort(a,n,ByPhone);
  InsSort(a,n,ByName);


PS. Там в примере выше в IsLess() были пропущены индексы при сравнениях a[j]<b[j] и наоборот, вписать самостоятельно.

bormant ★★★★★ ()
Последнее исправление: bormant (всего исправлений: 3)

что-то торможу

Не тормози! Компилируй с оптимизациями!

rupert ★★★★★ ()

Покажи блок-схему, по которой ты написал эту программу.

Virtuos86 ★★★★★ ()

Для начала хотя бы отформатируй код нормально и вставь его с подсветкой синтаксиса.

Miguel ★★★★★ ()
Ответ на: комментарий от Thetan

препод скажет «мы ещё не прошли процедуры и функции, переделывай»

А ТС сказал — не написать за меня а помочь разобраться. Вот разберется и напишет как надо. Или не разберется, кто ж его знает.

PS. Из структурированного кода сделать монолитный обычно проще, чем наоборот ;)

bormant ★★★★★ ()
Последнее исправление: bormant (всего исправлений: 1)

В сухом остатке:

const nmax=10; KeyBeg=15; KeyEnd=24;
type TLine = array [0..25] of Char;
var
  a: array [1..nmax] of TLine;
  t: TLine;
  n, i, j, k, p: Integer;
begin
  Assign(input,'in.txt'); Reset(input);
  Assign(output,'result.txt'); Rewrite(output);
  {n:=0;}
  while (n<nmax) and not EoF do begin
    Inc(n); ReadLn(a[n]); WriteLn(a[n]);
  end;
  for i:=2 to n do begin
    t:=a[i]; j:=i-1;
    while j>0 do begin
      for k:=KeyBeg to KeyEnd do begin
        p:=Ord(t[k])-Ord(a[j,k]);
        if p<>0 then Break;
      end;
      if p<0 then begin
        a[j+1]:=a[j]; Dec(j);
      end else Break;
    end;
    a[j+1]:=t;
  end;
  WriteLn; WriteLn('Sorted:');
  for i:=1 to n do WriteLn(a[i]);
  Close(input); Close(output);
end.

Там по сообщениям выше еще были описки (например, пропущен префиксный Inc(n) при чтении и т.п.), ночь и планшет не способствуют аккуратности, но общая идея должна быть понятна ;-)

bormant ★★★★★ ()
Последнее исправление: bormant (всего исправлений: 1)
Ответ на: комментарий от peregrine

Дело в том, что сделать данное задание нужно отдельно с процедурами, отдельно - без.

KrasnoGlazik ()
Ответ на: комментарий от KrasnoGlazik

Следовательно для сортировки использую от 16 до 25

Ужас какой. А record в этой задаче применять запрещено? И string уж заодно. (Хотя я уже не помню, был ли string в виртовском паскале, или его борланд добавил. Но record был точно.)

hobbit ★★★★★ ()
Ответ на: комментарий от Partisan

Pascal давно вышел из употребления и нет смысла его применять.

Брехня. Паскаль не самый популярный язык, но прикладные программы на нём таки пишут, причём довольно известные (Total Commander, например).

hobbit ★★★★★ ()
Ответ на: комментарий от hobbit

Брехня.

У меня не было цели вас вразумлять или устраивать с вами дискуссию. Я только дал полезное указание автору темы в учебных целях. Польза в том, что если он будет заниматься программированием, то ему следует знать, что придётся изучать ещё что-нибудь. Попытки программировать на Pascal бессмысленны (я знаю несколько программ, которые на нём написаны, но авторы просто не изучили чего-нибудь современного. Лучше бы их учили лучше). Практическая ценность знания Pascal равна 0 и ни на каком месте работы он не будет востребован.

Partisan ★★★ ()
Ответ на: комментарий от hobbit

record в этой задаче применять запрещено?

Очевидно, да. Его еще «не проходили» :-) Но судя по тому, что ТС говорил про «без процедур», и «с процедурами», дело может дойти и до разумных структур данных. И это правильный подход, имхо.

bormant ★★★★★ ()
Ответ на: комментарий от hobbit

Хотя я уже не помню, был ли string в виртовском паскале, или его борланд добавил

Специального типа у Вирта не описано, стрингом считался любой packed array [0..n] of char, хотя почти все реализации его добавляли. Борланд же знаменит своим особым стрингом, с хранением длины, который и стал визитной карточкой паскаля, хотя, формально, нарушает Виртовский стандарт.

redgremlin ★★★★★ ()
Ответ на: комментарий от redgremlin

особым стрингом, с хранением длины, который и стал визитной карточкой паскаля, хотя, формально, нарушает Виртовский стандарт.

Он не нарушает (у Вирта нет такого запрета), он его расширяет. К слову сказать в последних TP/BP и ASCIIZ строки есть, и компилятор обучен с ними работать — вон выше именно с ними пример приводил, там где array [0..size-1] of Char

var
  t: array [0..255] of Char; { это ASCIIZ строка }
  p: PChar;
begin
  ReadLn(t);  { её умеют обрабатывать ... }
  WriteLn(t); { ... утилиты ввода/вывода  }
  p:=t;  { а также, тип совместим с PChar }

bormant ★★★★★ ()
Последнее исправление: bormant (всего исправлений: 1)
Ответ на: комментарий от bormant

у Вирта нет такого запрета

Запрета так делать нет, но турбопаскалевский стринг реально же представляет из себя не packed array of char, a record len: byte; s: packed array of char; end; а работа с ним, как с packed array, является сахаром от компилятора. Почему я и говорю, что формально нарушает, неформально, конечно, на уровне программного кода,

for i:=0 to Length(s)-1 do Write(s[i]);
работает одинаково для разных реализаций.

redgremlin ★★★★★ ()
Последнее исправление: redgremlin (всего исправлений: 1)
Ответ на: комментарий от redgremlin

Была принята для данных нумерация от 1, не от 0, в элементе 0 собственно длина:

  for i:=1 to Ord(s[0]) do Write(s[i]); WriteLn;
  for i:=1 to Length(s) do Write(s[i]); WriteLn;

Сахар от компилятора в конкатенации по +, операциях сравнения и объявлении с указанием длины (String[сколько_надо]), остальное — стандартная библиотека.

bormant ★★★★★ ()
Последнее исправление: bormant (всего исправлений: 1)
Ответ на: комментарий от Partisan

Ничего лучше паскаля для обучения императивному программированию пока ещё не придумали.

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

anonymous ()
Ответ на: комментарий от anonymous

Ничего лучше паскаля для обучения императивному программированию пока ещё не придумали.

оберон же

anonymous ()
Ответ на: комментарий от anonymous

А идея о том, что надо сразу учиться писать на самом востребованном в промышленности языки

в университетах этот востребованный вообще нафиг не сдался, иначе и через 100 лет будет всё тот же си. в колледжах норм

anonymous ()

А записи ты использовать не пробовал? Будет же проще. И да, прокомментируй (или измени на понятные имена) самые важные переменные.

LongLiveUbuntu ★★★★★ ()

Задача так и не решилась. Да, я месяц пишу этот несчастный бред.

var
  isTrue: boolean;
  Arrx: array[1..25] of char;
  Arrf: array[1..25] of char;
  i, k,g,t, j: integer;
  Arr:array[1..10, 1..25] of char;

begin
  assign(input, '1in.txt');
  reset(input);
  assign(output, 'result.txt');
  rewrite(output);
  
  {Чтение из файла}
  for i := 1 to 10 do
  begin
    for j := 1 to 25 do
    begin
      read(Arr[i, j]);
      write(Arr[i, j]);
    end;
    readln;
    writeln
  end;
  writeln;
{Конец чтения из файла}



    
{Начало сортировки}

isTrue:= false;
for i:= 2 to 10 do
  begin
    for j:= 1 to 25 do
      begin
        k:= 16;
        Arrx[j]:= Arr[i - 1, j];
        Arrf[j]:= Arr[i, j];
          while (k <= 25) do
            begin
              if (Arrx[k] < Arrf[k]) then
                begin
                  isTrue:= true;
                  break;
                end
              else
                k:= k + 1; 
                
            if (isTrue = true) then
              begin
                for t:= 2 to 10 do
                  begin
                    for g:= 1 to 25 do
                      begin
                swap(Arr[t - 1, g], Arr[t, g]);
                end;
                end;
              end;
            end;
      
      end;
   end;      
        
        
{Конец сортировки}



{Вывод отсортированного массива}
  writeln('-' * 25);
  writeln(5*'  ' ,'Sorted: ');
  writeln('-' * 25);
  for i := 1 to 10 do
    begin
      for j := 1 to 25 do
      begin
        write(Arr[i, j]);
      end;
      writeln(' ');
    end;
  
end.

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

Просто уже не знаю, что делать. Испробовал все, что смог.

KrasnoGlazik ()

Вот это Pascal (комментарий) не устроило чем? Тем, что виндовый PascalABC не умеет читать ASCIIZ строку целиком по ReadLn? Ну замените ReadLn(a) на

  for j:=0 to 24 do Read(a[i,j]); ReadLn;

Что-то еще?

Совет про CyberForum.ru повторю.

PS. Перечитайте мои сообщения в теме, что осталось непонятно?

bormant ★★★★★ ()
Последнее исправление: bormant (всего исправлений: 2)
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.