Подскажите, как упростить код

@chloyka · Регистрация: 16.02.2016

Студворк — интернет-сервис помощи студентам

Доброго времени суток! Собственно кодить только начинаю, родные по такому случаю попросили сделать программу по работе. Программу написал, работает, все довольны. Однако хотелось бы как-то сократить или упростить, довести до вида, чтоб глаза радовала.

Слишком уж нагромождено. Только не смейтесь, я только учусь и не знаю, как можно написать по другому, но очень стараюсь

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
program tub;
uses crt;
var a,b,c,d,e,f,g,h:integer;
d1,d2,d3,d4,d5,d6,d7,d8,f1,f2:real;
begin
writeln('Укажите:');
writeln('Пол пациента 1 - мужской, 2 - женский');
readln (a);
writeln ('Форма туберкулеза 1 - Очаговый, 2 - Инфильтративный, 3 - Фиброзно-кавернозный, 4 Диссеминированный, Другие формы - 5');
readln (b);
writeln ('1 или 2х сторонняя локализация процесса 1 - Односторонняя, 2 - Двухсторонняя');
readln (c);
writeln ('Наличие полостей распада в легочной ткани; 1 - да, 2 - нет');
readln (d);
writeln ('Лекарственная устойчивость к изониазиду; 1 - да, 2 - нет');
readln (e);
writeln ('Лекарственная устойчивость к рифампицину; 1 - да, 2 - нет');
readln (f);
writeln ('Сопутствующая патология в виде хронических неспецифических заболеваний легких; 1 - да, 2 - нет');
readln (g);
writeln ('Вредные привычки 1 - Алкоголизм, 2 - Алкоголизм и курение, 3 - курение, 4 - наркомания, 5 - нет');
readln (h);
writeln ('Спасибо, дождитесь результатов, на слабом пк это может занять несколько часов, нажмите клавишу Enter, сли не хотите ждать');
readln;
 if a=1 then d1:=-0.611923;
  if a=2 then d1:=1.6297755;
 
 if b=1 then d2:=-1.677071948;
  if b=2 then d2:=-0.472185306;
   if b=3 then d2:=0.732701337;
    if b=4 then d2:=1.937587979;
     if b=5 then d2:=3.1424747621;
     
 if c=1 then d3:=-0.838548467;
  if c=2 then d3:=1.189313839;
  
 if d=1 then d4:=-0.461019271;
  if d=2 then d4:=2.163244272;
   
 if e=1 then d5:=-2.067397222;
  if e=2 then d5:=0.482392685;
     
 if f=1 then d6:=-2.364738552;
  if f=2 then d6:=0.482392685;
    
 if g=1 then d7:=-2.718283712;
  if g=2 then d7:=0.366884918;
    
 if h=1 then d8:=-1.512227025;
  if h=2 then d8:=-0.895331767;
   if h=3 then d8:=-0.278436509;
    if h=4 then d8:=0.33845875;
     if h=5 then d8:=0.955354008;
f1:=d1*-0.17956+d2*0.40778+d3*0.42102+d4*-0.50549+d5*-0.41049+d6*-0.18112+d7*0.24397+d8*-1.1129+-1.4663;
f2:=d1*-0.17140+d2*-0.30474+d3*-0.38007+d4*0.35164+d5*0.34494+d6*0.14447+d7*-0.25519+d8*0.95194+-1.07281;
 if f1>f2 then writeln ('Пациент с высокой степенью вероятности имеет риск хронического течения туберкулезного процесса.');
  if f1>f2 then writeln ('Рекомендовано:');
   if f1>f2 then writeln ('I. Интенсивная фаза химиотерапии:');
    if f1>f2 then writeln ('1) Лечение в условиях стационара.');
     if f1>f2 then writeln ('2) Обязательная консультация хирурга с решением вопроса о раннем оперативном лечении.');
      if f1>f2 then writeln ('II. Фаза продолжения:');
       if f1>f2 then  writeln ('1) В условиях дневного стационара или амбулаторно контролируемая.');
        if f1>f2 then  writeln ('2) Социальная поддержка в виде продовольственных пайков.');
  if f2>f1 then writeln ('Пациент с высокой степенью вероятности не имеет риска хронизации туберкулезного процесса.');
   if f2>f1 then writeln ('Рекомендовано:');
     if f2>f1 then writeln ('I. Интенсивная фаза химиотерапии:');
      if f2>f1 then writeln ('1) Лечение в условиях стационара или дневного стационара.');
       if f2>f1 then writeln ('2) Консультация хирурга по показаниям.');
        if f2>f1 then writeln ('II. Фаза продолжения:');
         if f2>f1 then writeln ('1) Контролируемая химиотерация в амбулаторных условиях.');
          writeln ('Нажмите любую клавишу для закрытия программы');
 readln;
end.

@Mogobeast · 17.02.2016, 20:31

Можно создать тип данных patient и туда запихать все данные, потом создать массив данного типа и туда уже вводить, чтобы можно было сразу вводить несколько пациентов за раз.

Добавлено через 4 минуты
И вот еще:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
f f1>f2 then begin 
 writeln ('Пациент с высокой степенью вероятности имеет риск хронического течения туберкулезного процесса.');
  writeln ('Рекомендовано:');
   writeln ('I. Интенсивная фаза химиотерапии:');
     writeln ('1) Лечение в условиях стационара.');
      writeln ('2) Обязательная консультация хирурга с решением вопроса о раннем оперативном лечении.');
      writeln ('II. Фаза продолжения:');
        writeln ('1) В условиях дневного стационара или амбулаторно контролируемая.');
          writeln ('2) Социальная поддержка в виде продовольственных пайков.');
          end;
  if f2>f1 then  begin
  writeln ('Пациент с высокой степенью вероятности не имеет риска хронизации туберкулезного процесса.');
   writeln ('Рекомендовано:');
      writeln ('I. Интенсивная фаза химиотерапии:');
       writeln ('1) Лечение в условиях стационара или дневного стационара.');
        writeln ('2) Консультация хирурга по показаниям.');
        writeln ('II. Фаза продолжения:');
          writeln ('1) Контролируемая химиотерация в амбулаторных условиях.');
          end;
          writeln ('Нажмите любую клавишу для закрытия программы');
 readln;
end.

@Vladonpw · 17.02.2016, 20:48

используй case of в случае, когда много вариантов
например,
case of b
1 :d2:=-1.677071948;
2 :d2:=-0.472185306;
3 :d2:=0.732701337;
4 :d2:=1.937587979;
5: d2:=3.1424747621;
end;

@Mogobeast · 17.02.2016, 20:51

Сообщение от Vladonpw

используй case of в случае, когда много вариантов
например,
case of b
1 :d2:=-1.677071948;
2 :d2:=-0.472185306;
3 :d2:=0.732701337;
4 :d2:=1.937587979;
5: d2:=3.1424747621;
end;

Опечатка, case b of, а не case of b.

@JuriiMW · 18.02.2016, 09:10

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
function Otvet(Vopros : String; VariantOtveta : array of String; Znachen : array of Real) : Real;
begin
  WriteLn('-'*50);
  WriteLn(Vopros);
  var Sel := 0;
  foreach var Variant in VariantOtveta do
    begin
      Sel += 1;
      WriteLn('  ' + Sel + ' - ' + Variant);
    end;
  var Vibor := 0;
  repeat
    Vibor := ReadLnInteger('Выберите от 1 до ' + Sel + ' :');
  until Vibor in [1..Sel];
  Result := Znachen[Vibor-1];
end;
 
function F1(d1, d2, d3, d4, d5, d6, d7, d8 : Real) : Real := d1*-0.17956+d2*0.40778+d3*0.42102+d4*-0.50549+d5*-0.41049+d6*-0.18112+d7*0.24397+d8*-1.1129+-1.4663;
function F2(d1, d2, d3, d4, d5, d6, d7, d8 : Real) : Real := d1*-0.17140+d2*-0.30474+d3*-0.38007+d4*0.35164+d5*0.34494+d6*0.14447+d7*-0.25519+d8*0.95194+-1.07281;
 
begin
  var d1 := Otvet('Пол пациента', arr('мужской', 'женский'), arr(-0.611923, 1.6297755));
  var d2 := Otvet('Форма туберкулеза', arr('Очаговый', 'Инфильтративный', 'Фиброзно-кавернозный', 'Диссеминированный', 'Другие формы'), arr(-1.677071948, -0.472185306, 0.732701337, 1.937587979, 3.1424747621));
  var d3 := Otvet('1 или 2х сторонняя локализация процесса', arr('Односторонняя', 'Двухсторонняя'), arr(-0.838548467, 1.189313839));
  var d4 := Otvet('Наличие полостей распада в легочной ткани', arr('да', 'нет'), arr(-0.461019271, 2.163244272));
  var d5 := Otvet('Лекарственная устойчивость к изониазиду', arr('да', 'нет'), arr(-2.067397222, 0.482392685));
  var d6 := Otvet('Лекарственная устойчивость к рифампицину', arr('да', 'нет'), arr(-2.364738552, 0.482392685));
  var d7 := Otvet('Сопутствующая патология в виде хронических неспецифических заболеваний легких', arr('да', 'нет'), arr(-2.718283712, 0.366884918));
  var d8 := Otvet('Вредные привычки', arr('Алкоголизм', 'Алкоголизм и курение', 'курение', 'наркомания', 'нет'), arr(-1.512227025, -0.895331767, -0.278436509, 0.33845875, 0.955354008));
 
  WriteLn('~'*50, NewLine, '~'*50);
  if F1(d1, d2, d3, d4, d5, d6, d7, d8) > F2(d1, d2, d3, d4, d5, d6, d7, d8) then
    WriteLn('Пациент с высокой степенью вероятности имеет риск хронического течения туберкулезного процесса.', NewLine,
      NewLine,
      'Рекомендовано:', NewLine,
      'I. Интенсивная фаза химиотерапии:', NewLine,
      '1) Лечение в условиях стационара.', NewLine,
      '2) Обязательная консультация хирурга с решением вопроса о раннем оперативном лечении.', NewLine,
      'II. Фаза продолжения:', NewLine,
      '1) В условиях дневного стационара или амбулаторно контролируемая.', NewLine,
      '2) Социальная поддержка в виде продовольственных пайков.')
  else
    WriteLn('Пациент с высокой степенью вероятности не имеет риска хронизации туберкулезного процесса.', NewLine,
      NewLine,
      'Рекомендовано:', NewLine,
      'I. Интенсивная фаза химиотерапии:', NewLine,
      '1) Лечение в условиях стационара или дневного стационара.', NewLine,
      '2) Консультация хирурга по показаниям.', NewLine,
      'II. Фаза продолжения:', NewLine,
      '1) Контролируемая химиотерация в амбулаторных условиях.');
end.

@chloyka · 18.02.2016, 13:08 **[ТС]**

Спасибо, интересное решение, буду разбираться

Добавлено через 54 минуты
Есть возможность запустить весь цикл заново по окончанию? я так понимаю, что label тут работать не будет.

@JuriiMW · 18.02.2016, 13:15

Сообщение от chloyka

запустить весь цикл

— Вынести основной модуль в процедуру, к примеру с именем Diagnostic.
— В основном модуле сделать цикл:

Pascal
1
2
3
4
5
6
begin
  repeat
    Diagnostic;
  until Otvet('Желаете повторить диагностику?', arr('ДА', 'НЕТ'), arr(+1.0, -1.0)) < 0;
  WriteLn('='*50, NewLine, 'Программа завершила свою работу.');
end.

@chloyka · 18.02.2016, 14:17 **[ТС]**

Тогда вылазит пара ошибок, мол встречено function, а ожидался оператор

@JuriiMW · 18.02.2016, 15:03

Ни чего не вылазит!
Всё компилируется „на ура“!

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
function Otvet(Vopros : String; VariantOtveta : array of String; Znachen : array of Real) : Real;
begin
  WriteLn('-'*50);
  WriteLn(Vopros);
  var Sel := 0;
  foreach var Variant in VariantOtveta do
    begin
      Sel += 1;
      WriteLn('  ' + Sel + ' - ' + Variant);
    end;
  var Vibor := 0;
  repeat
    Vibor := ReadLnInteger('Выберите от 1 до ' + Sel + ' :');
  until Vibor in [1..Sel];
  Result := Znachen[Vibor-1];
end;
 
function F1(d1, d2, d3, d4, d5, d6, d7, d8 : Real) : Real := d1*-0.17956+d2*0.40778+d3*0.42102+d4*-0.50549+d5*-0.41049+d6*-0.18112+d7*0.24397+d8*-1.1129+-1.4663;
function F2(d1, d2, d3, d4, d5, d6, d7, d8 : Real) : Real := d1*-0.17140+d2*-0.30474+d3*-0.38007+d4*0.35164+d5*0.34494+d6*0.14447+d7*-0.25519+d8*0.95194+-1.07281;
 
procedure Diagnostic;
begin
  var d1 := Otvet('Пол пациента', arr('мужской', 'женский'), arr(-0.611923, 1.6297755));
  var d2 := Otvet('Форма туберкулеза', arr('Очаговый', 'Инфильтративный', 'Фиброзно-кавернозный', 'Диссеминированный', 'Другие формы'), arr(-1.677071948, -0.472185306, 0.732701337, 1.937587979, 3.1424747621));
  var d3 := Otvet('1 или 2х сторонняя локализация процесса', arr('Односторонняя', 'Двухсторонняя'), arr(-0.838548467, 1.189313839));
  var d4 := Otvet('Наличие полостей распада в легочной ткани', arr('да', 'нет'), arr(-0.461019271, 2.163244272));
  var d5 := Otvet('Лекарственная устойчивость к изониазиду', arr('да', 'нет'), arr(-2.067397222, 0.482392685));
  var d6 := Otvet('Лекарственная устойчивость к рифампицину', arr('да', 'нет'), arr(-2.364738552, 0.482392685));
  var d7 := Otvet('Сопутствующая патология в виде хронических неспецифических заболеваний легких', arr('да', 'нет'), arr(-2.718283712, 0.366884918));
  var d8 := Otvet('Вредные привычки', arr('Алкоголизм', 'Алкоголизм и курение', 'курение', 'наркомания', 'нет'), arr(-1.512227025, -0.895331767, -0.278436509, 0.33845875, 0.955354008));
 
  WriteLn('~'*50, NewLine, '~'*50);
  if F1(d1, d2, d3, d4, d5, d6, d7, d8) > F2(d1, d2, d3, d4, d5, d6, d7, d8) then
    WriteLn('Пациент с высокой степенью вероятности имеет риск хронического течения туберкулезного процесса.', NewLine,
      NewLine,
      'Рекомендовано:', NewLine,
      'I. Интенсивная фаза химиотерапии:', NewLine,
      '1) Лечение в условиях стационара.', NewLine,
      '2) Обязательная консультация хирурга с решением вопроса о раннем оперативном лечении.', NewLine,
      'II. Фаза продолжения:', NewLine,
      '1) В условиях дневного стационара или амбулаторно контролируемая.', NewLine,
      '2) Социальная поддержка в виде продовольственных пайков.')
  else
    WriteLn('Пациент с высокой степенью вероятности не имеет риска хронизации туберкулезного процесса.', NewLine,
      NewLine,
      'Рекомендовано:', NewLine,
      'I. Интенсивная фаза химиотерапии:', NewLine,
      '1) Лечение в условиях стационара или дневного стационара.', NewLine,
      '2) Консультация хирурга по показаниям.', NewLine,
      'II. Фаза продолжения:', NewLine,
      '1) Контролируемая химиотерация в амбулаторных условиях.');
end;
 
begin
  repeat
    Diagnostic;
  until Otvet('Желаете повторить диагностику?', arr('ДА', 'НЕТ'), arr(+1.0, -1.0)) < 0;
  WriteLn('='*50, NewLine, 'Программа завершила свою работу.');
end.

@chloyka · 18.02.2016, 15:05 **[ТС]**

Сообщение от JuriiMW

Ни чего не вылазит!
Всё компилируется „на ура“!

Спасибо, нашел ошибку!

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .	Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»	SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .

Подскажите, как упростить код

Решение

Решение

@Vladonpw 1 / 1 / 0 Регистрация: 05.02.2014 Сообщений: 20
	17.02.2016, 20:48
	используй case of в случае, когда много вариантов например, case of b 1 :d2:=-1.677071948; 2 :d2:=-0.472185306; 3 :d2:=0.732701337; 4 :d2:=1.937587979; 5: d2:=3.1424747621; end; 1

@chloyka 138 / 6 / 5 Регистрация: 16.02.2016 Сообщений: 35
	18.02.2016, 13:08 [ТС]
	Спасибо, интересное решение, буду разбираться Добавлено через 54 минуты Есть возможность запустить весь цикл заново по окончанию? я так понимаю, что label тут работать не будет. 0

@chloyka 138 / 6 / 5 Регистрация: 16.02.2016 Сообщений: 35
	18.02.2016, 14:17 [ТС]
	Тогда вылазит пара ошибок, мол встречено function, а ожидался оператор 0