Имя пользователя:
Пароль:
 

Название темы: вопрос по Perl
Показать сообщение отдельно

Ветеран


Сообщения: 1405
Благодарности: 135

Профиль | Отправить PM | Цитировать


Можно еще задать вопрос ?
Сам нижеприведенный скрипт уже почти готовый, однако меня интересует, какие ошибки, в том числе стилистические и алгоритмические допущены и пути улучшения?

Код: Выделить весь код
#Задача: принять арифметическое выражение и вычислить его значение. Возможны следующие арифм. операции : сложение, умножение, деление, вычитание, возведение в степень, вычисление факториала. Допускается вложенность скобок любого уровня и работа с  отрицательными числами, заключение в скобки отрицательных чисел необязательно. Поддерживаются числа с плавающей точкой: напр. 8.23 5.9001

#TODO: проверка правильности скобок т е соответствия правых и левых скобок
#TODO: более тщательный разбор входящей строки

#Примеры использования:
#2+3*6-(-7)^(3!)
#((3*6)+5)^(2!+5)-5!
# 8!-7!*6

$msg="Разбор арифметических выражений. 
Выйти - Ctrl+Z или Ctrl+C
Приоритет операций: () ! ^ * / + - 
Приоритет операциям / и * надо задавать явно
\n";
 
&print($msg);

for (;$expression  ne "\cZ";){

 $msg="Введите выражение: ";
 &print($msg);
 $expression=<STDIN>; 
 chomp($expression);
 $expression=~s/ //g;
 $expression=skob($expression);
 print "Result = $expression\n";
}

sub skob() {
# функция вычисляет выражения стоящее в скобках и записывает это значение вместо скобки

my $result;
my $flag;
my $counter;
my $lent;
my $newstr;
my $startposition;

#проверяем, есть ли вообще в выражении скобки
if ( $_[0] =~/\(/ || $_[0]=~/\)/ ) {
   $flag=0;
   for ($counter=0; $counter < length ($_[0]); $counter++){
      if ( (substr ($_[0], $counter,1)) eq '('){ #определяем начало скобки
         $flag+=1; 
         #увеличиваем значение флаговой переменной, и если увеличение произошло в первый раз,                  
         #заносим в переменную $startposition номер символа подстроки, в котором находится скобка
         if ($flag==1){
            $startposition=$counter;
            }
         }
      elsif ( (substr ($_[0], $counter,1)) eq ')'){#определяем конец скобки
         $flag-=1; #уменьшаем значение флаговой переменной
         if ($flag==0){ # когда в этом месте флаг превратится в ноль, т.е. закончится скобка               
            $lent = length ($newstr) + 2; 
            $newstr = skob ($newstr); #рекурсивно вызываем функцию заново,
                                      #чтобы проверить, есть ли в считанной скобке другие скобки
                                      #возвращаемое значение - результат вычисления скобки
            substr ($_[0], $startposition, $lent) = $newstr; #замена скобки на ее значение            
            $counter-=$lent; #уменьшение счетчика на длину скобки, 
                             #т.к. в выражении могут присутствовать 
                             #2 рядом стоящие скобки 
                             #поэтому нужно считать строку до конца
            $newstr=undef; #?       
            }   
         }
          
      # если мы внутри скобки (т.е. $flag>0) И $startposition< счетчика,
      # то заносим в переменную $newstr содержимое скобки
      if ($flag>0  && $startposition <$counter){
           $newstr .=substr ($_[0], $counter,1)}
   } 
}

$result=vichislenie($_[0]); #вычисление значения скобки
return $result;
}


sub vichislenie(){
   @znaki=();#знаки выражения
   @cyfers=(); # цифры

#чтение полученного выражения
for ($counter=0, $arraycnt=0, $currentposition=0; $counter <length($_[0]);$counter++){
   # $_[0] - выражение, которое нужно вычислить
   # $counter - счетчик массива $_[0]
   # $arraycnt - счетчик массива  @znaki
   # $currentposition - текущая позиция в массиве $_[0]
 
   #если встретили символ арифметичсекой операции  
   if (substr($_[0],$counter,1) eq '+' ||
   (substr($_[0],$counter,1) eq '-'&& 
   substr($_[0],$counter-1,1) ne '-' && 
   substr($_[0],$counter-1,1) ne '+' && 
   substr($_[0],$counter-1,1) ne '*'&& 
   substr($_[0],$counter-1,1) ne '/' &&
   substr($_[0],$counter-1,1) ne '^') ||
   substr($_[0],$counter,1) eq '*'|| 
   substr($_[0],$counter,1) eq '/' || 
   substr($_[0],$counter,1) eq '^')
    {
       #заносим в массив знак. арифм. операции
       $znaki[$arraycnt]=substr($_[0],$counter,1);

       #заносим в массив цифру (т.е. содержимое строки между знаками)
       #вместе с цифрой заносится и отрицательный знак, если он есть
       for ($i=$currentposition; $i<$counter;$i++){ 
         $cyfers[$arraycnt].=substr($_[0],$i,1);}
    
       #вычисление факториала       
       if ($cyfers[$arraycnt]=~/(.*)!/){
         $cyfers[$arraycnt]=factorial($1);
       }
       $currentposition=$counter+1;
       $arraycnt++;
    }
}


for ($i=$currentposition; $i<length($_[0]);$i++){
#чтобы не потерять последнюю цифру
   $cyfers[$arraycnt].=substr($_[0],$i,1);

#вычисление факториала
   if ($cyfers[$arraycnt]=~/(.*)!/){
   $cyfers[$arraycnt]=factorial($1);
   }
}

#выполнение арифметических операций
operation("\^");
operation("\*");
operation("\/");
operation("\+");
operation("\-");

#возвращение результата вычислений
return ($cyfers[0]);
}

sub print($msg){
 my $msg=$_[0];
 wintodos($msg); #перекодировка строки из win в dos, чтобы русские буквы нормально показывались в терминале
 printf ("%s", $msg);
}

sub operation(){
 my $counter;
 my $result;
 for ($counter=0; $counter<@znaki;){
  if($znaki[$counter] eq $_[0]){
   $result=$cyfers[$counter]**$cyfers[$counter+1] if ( $_[0] eq "\^");
   $result=$cyfers[$counter]*$cyfers[$counter+1] if ( $_[0] eq "\*");
   $result=$cyfers[$counter]/$cyfers[$counter+1] if ( $_[0] eq "\/");
   $result=$cyfers[$counter]+$cyfers[$counter+1] if ( $_[0] eq "\+");
   $result=$cyfers[$counter]-$cyfers[$counter+1] if ( $_[0] eq "\-");
   $cyfers[$counter]=$result;
    
   #уничтожение одного элемента массива 
   @cyfers=sdvig (@cyfers,$counter+1);
   @znaki=sdvig (@znaki,$counter);
   }
 else {
    $counter++;}
 }
}

sub sdvig(){
   my $lent=length(@_);
   my $counter= $_[-1];
   my @array=@_;
   $#array--;
   for ($tmp=$counter; defined($array[$tmp+1]);$tmp++){
      $array[$tmp]=$array[$tmp+1];
   }
   $#array--;
   return @array;

   }

sub factorial {
   my $result;
   my @b;
   my $i;

   $result=1;
   @b =(1 .. $_[0]);
   for($i=1;$i<$_[0];$i++) {
      $result= ($b[$i])* $result;
   }
   return $result;
}

sub wintodos {
      $_[0]=~s/\xe0/\xa0/g;
      $_[0]=~s/\xe1/\xa1/g;
      $_[0]=~s/\xe2/\xa2/g;
      $_[0]=~s/\xe3/\xa3/g;
      $_[0]=~s/\xe4/\xa4/g;
      $_[0]=~s/\xe5/\xa5/g;
      $_[0]=~s/\xe6/\xa6/g;
      $_[0]=~s/\xe7/\xa7/g;
      $_[0]=~s/\xe8/\xa8/g;
      $_[0]=~s/\xe9/\xa9/g;
      $_[0]=~s/\xea/\xaa/g;
      $_[0]=~s/\xeb/\xab/g;
      $_[0]=~s/\xec/\xac/g;
      $_[0]=~s/\xed/\xad/g;
      $_[0]=~s/\xee/\xae/g;
      $_[0]=~s/\xef/\xaf/g;
      $_[0]=~s/\xf0/\xe0/g;
      $_[0]=~s/\xf1/\xe1/g;
      $_[0]=~s/\xf2/\xe2/g;
      $_[0]=~s/\xf3/\xe3/g;
      $_[0]=~s/\xf4/\xe4/g;
      $_[0]=~s/\xf5/\xe5/g;
      $_[0]=~s/\xf6/\xe6/g;
      $_[0]=~s/\xf7/\xe7/g;
      $_[0]=~s/\xf8/\xe8/g;
      $_[0]=~s/\xf9/\xe9/g;
      $_[0]=~s/\xfa/\xea/g;
      $_[0]=~s/\xfb/\xeb/g;
      $_[0]=~s/\xfc/\xec/g;
      $_[0]=~s/\xfd/\xed/g;
      $_[0]=~s/\xfe/\xee/g;
      $_[0]=~s/\xff/\xef/g;

      $_[0]=~s/\xc0/\x80/g;
      $_[0]=~s/\xc1/\x81/g;
      $_[0]=~s/\xc2/\x82/g;
      $_[0]=~s/\xc3/\x83/g;
      $_[0]=~s/\xc4/\x84/g;
      $_[0]=~s/\xc5/\x85/g;
      $_[0]=~s/\xc6/\x86/g;
      $_[0]=~s/\xc7/\x87/g;
      $_[0]=~s/\xc8/\x88/g;
      $_[0]=~s/\xc9/\x89/g;
      $_[0]=~s/\xca/\x8a/g;
      $_[0]=~s/\xcb/\x8b/g;
      $_[0]=~s/\xcc/\x8c/g;
      $_[0]=~s/\xcd/\x8d/g;
      $_[0]=~s/\xce/\x8e/g;
      $_[0]=~s/\xcf/\x8f/g;
      $_[0]=~s/\xd0/\x90/g;
      $_[0]=~s/\xd1/\x91/g;
      $_[0]=~s/\xd2/\x92/g;
      $_[0]=~s/\xd3/\x93/g;
      $_[0]=~s/\xd4/\x94/g;
      $_[0]=~s/\xd5/\x95/g;
      $_[0]=~s/\xd6/\x96/g;
      $_[0]=~s/\xd7/\x97/g;
      $_[0]=~s/\xd8/\x98/g;
      $_[0]=~s/\xd9/\x99/g;
      $_[0]=~s/\xda/\x9a/g;
      $_[0]=~s/\xdb/\x9b/g;
      $_[0]=~s/\xdc/\x9c/g;
      $_[0]=~s/\xdd/\x9d/g;
      $_[0]=~s/\xde/\x9e/g;
      $_[0]=~s/\xdf/\x9f/g;
      }

Отправлено: 08:06, 30-11-2004 | #13

Название темы: вопрос по Perl