Все выпуски  

RFpro.ru: Программирование на Delphi и Lazarus


Хостинг портала RFpro.ru:
Московский хостер
Профессиональный ХОСТИНГ на базе Linux x64 и Windows x64

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Лучшие эксперты данной рассылки

Boriss
Статус: Академик
Рейтинг: 2498
∙ повысить рейтинг »
star9491
Статус: Профессионал
Рейтинг: 2428
∙ повысить рейтинг »
Евгений/Genia007/
Статус: Профессионал
Рейтинг: 1109
∙ повысить рейтинг »

/ КОМПЬЮТЕРЫ И СОФТ / Программирование / Delphi и Lazarus

Номер выпуска:1560
Дата выхода:22.10.2010, 00:00
Администратор рассылки:Калашников О.А. (Руководитель)
Подписчиков / экспертов:285 / 195
Вопросов / ответов:1 / 1

Вопрос № 180297: Добрый день, эксперты. Помогите в написании программы на delphi. Данные заданы в таблице Найти сходство между объектами Х1 и Х2, Х2 и...



Вопрос № 180297:

Добрый день, эксперты.
Помогите в написании программы на delphi.
Данные заданы в таблице

Найти сходство между объектами Х1 и Х2, Х2 и Х3, Х1 и Х3, Х4 и Х5 используя формулы

n-количество свойств.

Отправлен: 12.10.2010, 23:42
Вопрос задал: Kreaman (Посетитель)
Всего ответов: 1
Страница вопроса »


Отвечает lamed (Профессор) :
Здравствуйте, Kreaman!
Доброе утро! Проверено Delphi 7.

Код:
program p180297;
// В задаче производится только проверка открытия файла-источника
// и создания файла-приемника
// По-хорошему, должна быть также проверка каждого чтения,
// каждой записи и закрытия

{$APPTYPE CONSOLE}

uses
SysUtils;

const
MaxParam = 10; // Максимальное число параметров
MaxElement = 100; // Максимальное число строк
n = 7; // Число строк (временно, для отладки)
type
TBool = 0..1;
TVector = array[1..MaxParam] of TBool;
TElement = record
name : string[20];
v : TVector;
end;
TMatrix = array[1..MaxElement] of T Element;
TParamNames = array[1..MaxParam] of string[20];
TFunc = function(xi, xj: TVector; n: integer): real;
// ---------- Functions ----------
Function a(xi, xj: TVector; n: integer): integer;
Var
k: integer;
Sum: integer;
Begin
sum :=0;
For k:= 1 to n do
sum := sum+xi[k]*xj[k];
a:=sum;
End;

Function b(xi, xj: TVector; n: integer): integer;
Var
k: integer;
Sum: integer;
Begin
sum:=0;
For k:= 1 to n do
sum := sum+(1-xi[k])*(1-xj[k]);
b:=sum;
End;

Function h(xi, xj: TVector; n: integer): integer;
Var
k: integer;
Sum: integer;
Begin
sum :=0;
For k:= 1 to n do
sum := sum+(1-xi[k])*xj[k];
h:=sum;
End;

Function g(xi, xj: TVector; n: integer): integer;
Var
k: integer;
Sum: integer;
Begin
sum :=0;
For k:= 1 to n do
sum := sum+xi[k]*(1-xj[k]);
g:=sum;
End;

Function s1(x i, xj: TVector; n: integer): real;
Begin
S1:= a(xi,xj,n)/(n-b(xi,xj,n));
End;

Function s2(xi, xj: TVector; n: integer): real;
Begin
S2:= a(xi,xj,n)/(g(xi,xj,n)+h(xi,xj,n));
End;

procedure CalcWrite(m: TMatrix; s: TFunc; params: integer; elems: integer; var f:text);
var
i, j: integer;
begin
for i:= 1 to elems-1 do
for j:= i+1 to elems do
writeln(f, 'X',i,' и X',j,'=',s(m[i].v,m[j].v,params)*100:5:2, '%');
end;

// --------------------
var
i, j: integer;
p: integer;
CalcType: integer;
str: string;
m: TMatrix;
InFile, OutFile: text;
InFileName, OutFileName: string[30];
params, elems: integer;
pNames: TParamNames;

// ---------- main ----------
begin
// Запрашиваем имена файла-источника и файла-приемника
write('Входной файл ');
readln(InFileName);

write('Выходной файл ');
readln(OutFileName);

{$I-}
AssignFile(InFile, InFileName);
reset(InFile);
{$I+}
if (IOResult <> 0) or (InFileName = '') then
begin
writeln('Файл данных не найден! Задача завершается');
readln;
halt;
end;

{$I-}
AssignFile(OutFile, OutFileName);
rewrite(OutFile);
{$I+}
if (IOResult <> 0) or (OutFileName = '') then
begin
writeln('Не могу создать выходной файл! Задача завершается');
readln;
halt;
end;

readln(InFile, str);

// Прочитали число и список параметров
params := 1;
p:= pos(';', str);
while (p>0) do
begin
pNames[params]:=copy(str,1,p-1);
delete(str,1,p);
inc(params,1);
p:= pos(';', str);
end;
pNames[params] := str;

// Прочитали число и список объектов

elems := 0;
while not eof(InFile) do
begin
inc(elems);
readln(InFile, str);
p:= pos(';', str);
m[e lems].name := copy(str,1,p-1);
delete(str,1,p);

for i:= 1 to params-1 do
begin
p:= pos(';', str);
m[elems].v[i]:=StrToInt(copy(str,1,p-1));
delete(str,1,p);
end;
m[elems].v[params]:=StrToInt(str);
end;

close(InFile);

// Отпечатали список параметров
write(OutFile, 'Объект':10);
for i:= 1 to params do
write(OutFile, pNames[i]:15);
writeln(OutFile);

// Отпечатали список объектов
for i:= 1 to elems do
begin
write(OutFile, m[i].name:10);
for j:= 1 to params do
write(OutFile, m[i].v[j]:10, ' ':5);
writeln(OutFile);
end;

writeln(OutFile, 'Параметров=', params, ',объектов=', elems);

// Запрашиваем тип расчета и выполняем расчет
// Сохраняем результаты в файл-приемник
write('Выберите тип расчета (1 или 2)');< br> readln(CalcType);
if not (CalcType in [1..2]) then
begin
writeln('Вы выбрали неверный тип. Будет выполнен расчет по умолчанию (тип 1)');
CalcType:= 1;
end;
writeln(OutFile, 'Формула сходства S',CalcType);
case calctype of
1: CalcWrite(m, s1, params, elems, OutFile);
2: CalcWrite(m, s2, params, elems, OutFile);
else
writeln(OutFile, 'ошибка');
end;
Close(OutFile);
Writeln('Удачи!');
Readln;
end.


Входной файл
Код:
Желтый?;Красный?;Есть семечка?;Есть косточка?
Вишня;0;1;0;1
Яблоко;1;1;1;0
Банан;1;0;0;0
Слива;1;1;0;1
Гру ша;1;0;1;0


Примеры выходного файла
Код:
   Объект        Желтый?       Красный?  Есть семечка? Есть косточка?
Вишня 0 1 0 1
Яблоко 1 1 1 0
Банан 1 0 0 0
Слива 1 1 0 1
Груша 1 0 1 0
Параметров=4,объектов=5
Формула сходства S1
X1 и X2=25.00%
X1 и X3= 0.00%
X1 и X4=66.67%
X1 и X5= 0.00%
X2 и X3=33.33%
X2 и X4=50.00%
X2 и X5=66.67%
X3 и X4=33.33%< br>X3 и X5=50.00%
X4 и X5=25.00%


Код:
   Объект        Желтый?       Красный?  Есть семечка? Есть косточка?
Вишня 0 1 0 1
Яблоко 1 1 1 0
Банан 1 0 0 0
Слива 1 1 0 1
Груша 1 0 1 0
Параметров=4,объектов=5
Формула сходства S2
X1 и X2=33.33%
X1 и X3= 0.00%
X1 и X4=200.00%
X1 и X5= 0.00%
X2 и X3=50.00%
X2 и X4=100.00%
X2 и X5=200.00%
X3 и X4=50.00%
X3 и X5=100.00%
X4 и X5=33.33%


Примечание. По-моему, формула S2 содержит ошибку. Сходство между X1 и X4 со ставляет 200%, что подтверждается ручным счетом. Если требуются уточнения, задавайте вопросы в мини-форум.

Ответ отправил: lamed (Профессор)
Ответ отправлен: 20.10.2010, 12:31
Номер ответа: 263567

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это!
Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 263567 на номер 1151 (Россия) | Еще номера »
  • Отправить WebMoney:


  • Оценить выпуск »
    Нам очень важно Ваше мнение об этом выпуске рассылки!

    Задать вопрос экспертам этой рассылки »

    Скажите "спасибо" эксперту, который помог Вам!

    Отправьте СМС-сообщение с тестом #thank НОМЕР_ОТВЕТА
    на короткий номер 1151 (Россия)

    Номер ответа и конкретный текст СМС указан внизу каждого ответа.

    Полный список номеров »

    * Стоимость одного СМС-сообщения от 7.15 руб. и зависит от оператора сотовой связи. (полный список тарифов)
    ** При ошибочном вводе номера ответа или текста #thank услуга считается оказанной, денежные средства не возвращаются.
    *** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.


    © 2001-2010, Портал RFPRO.RU, Россия
    Авторское право: ООО "Мастер-Эксперт Про"
    Автор: Калашников О.А. | Программирование: Гладенюк А.Г.
    Хостинг: Компания "Московский хостер"
    Версия системы: 2010.6.22 от 18.10.2010

    В избранное