Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Центр помощи > [Delphi] Сортировка и Списки.


Автор: Ne_Ice 26.1.2008, 20:41
В уинивере задали 2 задачи, первый на сортировку, вторая на списки:
1.Есть некий измерительный прибор, работа которого зависит от входных параметров a и x, а результат определяется следующей формулой у = a sin(ax) cos2 (x/a). Проводится серия опытов для значений xt ,х2,... xn, a = const. Вывести результат в виде таблицы, упорядоченной по убыванию значений показаний прибора, полученных в ходе опытов.
2.Дан текстовый файл. Распечатать слова, имеющие максимальную длину.
Заранее спасибо smile 

Автор: kemiisto 27.1.2008, 02:59
Задача 1:

Код

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  vector = array of Real;

function f(x, a: Real): Real;
begin
  f := a * sin(a * x) * cos(2 * x/a);
end;

procedure Sort(x_inp, y_inp: vector; var x_out, y_out: vector);
var
  i, j, n: Integer;
  k: array of Integer;
begin
  n := Length(x_inp);
  SetLength(k, n);
  for i := 0 to n - 1 do
    k[i] := 0;
  for i := 1 to n - 1 do
    for j := 0 to i - 1 do
      if y_inp[i] > y_inp[j]
        then k[j]:=k[j] + 1
        else k[i]:=k[i] + 1;
  for i := 0 to n - 1 do
  begin
    y_out[k[i]] := y_inp[i];
    x_out[k[i]] := x_inp[i];
  end;
end;

var
  x_inp, y_inp, x_out, y_out: vector;
  n, i: Integer;
  a: Real;
begin
  Write('Vvedite a: ');
  Readln(a);
  Write('Vvedite kol-vo izmerenii: ');
  Readln(n);
  SetLength(x_inp, n);
  SetLength(y_inp, n);
  SetLength(x_out, n);
  SetLength(y_out, n);  
  for i := 0 to n - 1 do
  begin
    Write('Vvedite x[', i + 1, ']: ');
    Readln(x_inp[i]);
    y_inp[i] := f(x_inp[i], a);
  end;
  Sort(x_inp, y_inp, x_out, y_out);
  Writeln('Tablitsa rezultatov:');
  for i := 0 to n - 1 do  
    Writeln(x_out[i]:10:9, ' | ', y_out[i]:10:9);
  Readln;
end.


Все пока! Спать охота ...

Автор: qwertu 27.1.2008, 13:07
kemiisto,  Спасибо большое, ещё бы вторую...

Автор: kemiisto 27.1.2008, 13:07
Задача 2

Код

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

function Parse(Char, S: string; Count: Integer): string;
var
  I: Integer;
  T: string;
begin
  if S[Length(S)] <> Char then
    S := S + Char;
  for I := 1 to Count do
  begin
    T := Copy(S, 0, Pos(Char, S) - 1);
    S := Copy(S, Pos(Char, S) + 1, Length(S));
  end;
  Result := T;
end;

var
  F: Text;
  s, temp: string;
  longest: array of string;
  i, count: Integer;
begin
  Assign(F, 'C:\1.txt');
  Reset(F);
  Readln(F, s);
  SetLength(longest, 1);
  count := 1;
  while s <> '' do
  begin
    temp := Parse(' ', s, 1);
    Delete(s, 1, Length(temp) + 1);
    if Length(temp) > Length(longest[0]) then
    begin
      SetLength(longest, 1);
      count := 1;
      longest[0] := temp;
    end
    else
      if Length(temp) = Length(longest[0]) then
      begin
        Inc(count);
        SetLength(longest, count);
        longest[count - 1] := temp;
      end;
  end;
  for i := 0 to Length(longest) - 1 do
    Writeln(longest[i]);
  Readln; 
end.


Файл C:\1.txt прилагаю:

Автор: kemiisto 27.1.2008, 13:34
Концовочку чуть поправил:

Код

  for i := 0 to count - 1 do
    Writeln(longest[i]);
  Close(F);


Добавлено через 4 минуты
Вот сами проекты:

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)