Подскажите, как упростить код - PascalABC.NET

Узнай цену своей работы

Формулировка задачи:

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

Решение задачи: «Подскажите, как упростить код»

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

Объяснение кода листинга программы

  • В функции Otvet происходит выбор варианта ответа из предложенных.
    • Переменная Sel используется для подсчета количества вариантов ответа.
    • Пользователю предлагается выбрать вариант ответа с помощью функции ReadLnInteger.
    • Если выбранный вариант ответа находится в допустимом диапазоне, то значение переменной Vibor изменяется в соответствии с выбранным вариантом ответа.
    • Значение переменной Vibor затем используется для получения соответствующего значения из массива Znachen.
    • Функции F1 и F2 представляют собой формулы для вычисления значений, основанные на входных данных.
    • В процедуре Diagnostic используются эти функции для вычисления значений и сравнения результатов.
    • Если результат функции F1 больше, чем результат функции F2, то выводится сообщение о высоком риске хронического течения туберкулезного процесса и рекомендации по лечению.
    • В противном случае выводится сообщение о низком риске хронизации туберкулезного процесса и рекомендации по лечению.
    • Пользователю предлагается повторить диагностику, пока он не введет НЕТ.
    • В конце программы выводится сообщение об окончании работы программы.

ИИ поможет Вам:

  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

14   голосов , оценка 3.857 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут