VPF::[Delphi] Сортировка и Списки. - Форум программистов

Ne_Ice

Дата 26.1.2008, 20:41 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 24.1.2008

Репутация: нет
Всего: нет

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

kemiisto

Дата 27.1.2008, 02:59 (ссылка)

(нет голосов)

Загрузка ...

Дикий Кот. =^.^=

Награды: 1

Профиль
Группа: Участник Клуба
Сообщений: 3292
Регистрация: 29.7.2007

Репутация: 16
Всего: 160

Задача 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.

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

--------------------

XMPP-канал.

Unit testing isn't enough. You need static typing.

Пей, кури, пиши на си! smile

qwertu

Дата 27.1.2008, 13:07 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 26.1.2008

Репутация: нет
Всего: нет

kemiisto, Спасибо большое, ещё бы вторую...

kemiisto

Дата 27.1.2008, 13:07 (ссылка)

(нет голосов)

Загрузка ...

Дикий Кот. =^.^=

Награды: 1

Профиль
Группа: Участник Клуба
Сообщений: 3292
Регистрация: 29.7.2007

Репутация: 16
Всего: 160

Задача 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 прилагаю:

Присоединённый файл ( Кол-во скачиваний: 2 )

1.txt 0,29 Kb

--------------------

XMPP-канал.

Unit testing isn't enough. You need static typing.

Пей, кури, пиши на си! smile

kemiisto

Дата 27.1.2008, 13:34 (ссылка)

(нет голосов)

Загрузка ...

Дикий Кот. =^.^=

Награды: 1

Профиль
Группа: Участник Клуба
Сообщений: 3292
Регистрация: 29.7.2007

Репутация: 16
Всего: 160

Концовочку чуть поправил:

Код


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

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

Присоединённый файл ( Кол-во скачиваний: 9 )

projects.zip 75,22 Kb

--------------------

XMPP-канал.

Unit testing isn't enough. You need static typing.

Пей, кури, пиши на си! smile

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »