Program on Perl lang for SPQ (pre-alfa v.0.0.1)
ign...@gmail.com
###Program on Perl lang for translation physical quantity (any simbol
from @arr_input) to formula of different physical quantities
(%total_var)
##передаем исходный формулы
my @arr_input = (
['Q','=','N','*','Eps0'],
[ qw(Q = Tau * l) ],
['Tau','=','U','*','Eps0'],
['U','=','E','*','l'],
['Sigma','=','E','*','Eps0'],
# ['F','=','Tau','*','U'],
# ['F','=','E','*','Q'],
['F','=','N','*','Sigma']
);
##передаем физические величины из
котрых может быть составленна искомая
формула
my %total_var=('Q' => 1,'l'=> 1, 'Eps0' => 1);
#my %total_var=('N' => 1, 'Sigma' => 1);
my @arr_output = ();
###данная функция реализует
автоматическую замену знака '*' на '/' и
наоборот, при формирование из
исходного массива(@arr_input) формул
обобщенный массив(@arr_output)
sub flip_operation {
my $sim=shift;
if ($sim eq '*') { $sim='/';}
elsif ($sim eq '/') { $sim='*';}
else {die "Parsing error !!!\n";}
}
###функция преоразования исходного
массива. Проводя действя со строками
переданного массива, получаем из
набора исходных формул все возможные
варианты выражения велечин, т.е. приняв
на входе одно выражение Q=N*Eps0 на выходе
получаем три выражения Q=N*Eps0, N=Q\Eps0 и
Eps0=Q\N.
sub make_arr_output {
my @cur_arr= @_; #присваеваем @cur_arr исходный
массив @arr_input
my @tmp_formula; #определяем массив в котором
будет хранится полученный формулы
foreach my $cur_line ( @cur_arr) { #обабатываем
исходный массив, проходя по каждому
элементу каждой формулы
push (@arr_output,[@$cur_line]); #помещяем в @arr_output
столбцы из обрабатываемого массива
@cur_arr
push(@tmp_formula,@$cur_line[2],@$cur_line[1],@$cur_line[0],
flip_operation(@$cur_line[3]),@$cur_line[4]); # в массив
@tmp_formula на место первого столбца
помещяем столбец @$cur_line[2]
соответствующего второму столбцу
массива @cur_arr, далее помещяем второй
столбец @$cur_line[1] исходного массива,
соответствующий знаку "=", и так далее,
т.о. получам выражение первого члена из
исходной формулы.
push (@arr_output,[@tmp_formula]); # записываем в
массив @arr_otput полученный результат
@tmp_formula=(); # очищяем массив
push(@tmp_formula,@$cur_line[4],@$cur_line[1],@$cur_line[0],
flip_operation(@$cur_line[3]),@$cur_line[2]); #проделываем
тоже самое, только выражаем второй
член из исходной формулы
push (@arr_output,[@tmp_formula]); # добовляем в
выходной массив новые значения
@tmp_formula=(); # снова очищяем массив
}
}
###запускаем функцию с переданным
параметром
&make_arr_output(@arr_input);
my @isp_form=();
my %isp_gr_form=();
###функция определению номера группы по
номеру формулы
sub group_number {
##в качестве аргумента передается
номер формулы, далее путем деления
переданного значения на "3" получаем
номер группы этой формулы. Группой
формуля счетается тройка формул
вытекающих другн из друга. Например
Q=N*Eps0, N=Q\Eps0 и Eps0=Q\N.
my $chis=shift; # определяем переданное
число
my $n = int ($chis/3); # делем число на "3"
return $n; # возвращяем полученный номер
группы
}
### Это функция поиска подходящих
формул (На основании вхождения
упорядоченных символов)
sub search_number_of_formula {
my ($simbol1,$simbol2,$simbol3)=@_; #пердаём
переданный в функцию аргументы
my @isp_form; #определяем массив
использованных формул
my $i=0;
my @search_condition; #определяем массив
наличия нужного значения
my ($cur_iter1,$cur_iter2,$cur_iter3);
#print "Sim: $simbol1\n";
##формирование строки гибкого условия
для поиска по одному двум или трем
переданным аргументам
if (defined $simbol1) { push (@search_condition, '$cur_iter1 eq
$simbol1'); }
else {die "Simbol1 not defined : $! \n";}
if (defined $simbol2) { push (@search_condition, '$cur_iter2 eq
$simbol2'); }
if (defined $simbol3) { push (@search_condition, '$cur_iter3 eq
$simbol3'); }
foreach my $iter (@arr_output){
##блок прохождения по массиву
$cur_iter1 = @$iter[0]; #$cur_iter1 присваевается
значения первого элемента формулы
$cur_iter2 = @$iter[2]; # --#--
$cur_iter3 = @$iter[4];
if (
eval (join ( " and ", @search_condition) ) #выполнение
созданной строки условия, которое
обединяется из массива посредством
операции "И"
) {
push (@isp_form,$i);#в массив формул помещяем
номер найденной формулы
} else {
}
$i++;
}
return @isp_form; #возвращяем массив
}
# Поиск подформул, заполнение хеша
групп, вызов рекурсии для каждой новой
группы
sub branch {
my($b_el,%isp_gr_form)=@_; #передача символа
физической величены и хеша с номерами
использованных групп формул
my(@poisk_v_shir1,$cur_gr,$cur_form); #массив для
найденных формул(групп формул)
# А это мы осуществляем поиск подформул
if ( exists $total_var{$b_el} ) { return $b_el;} #операция
проверки, возвращяется введенный
символ
@poisk_v_shir1=&search_number_of_formula($b_el); #поиск
всех формул для вычесления
переданного символа
##перебор всех формул, найденных для
данного символа
foreach my $f_num_1 (@poisk_v_shir1) {
$cur_gr=&group_number($f_num_1); #вычесления номера
группы
##если данная группа формул уже
использована, то преходжим к следующей
формуле
unless ( exists $isp_gr_form{$cur_gr}) {
$isp_gr_form{$cur_gr}++;
$cur_form=&perebor($f_num_1,%isp_gr_form); #вычисление
формулы путем поиска в глубену по
дереву заданных формул
return $cur_form; #возвращяем вычесленную
формулы
} else {
$isp_gr_form{$cur_gr}++;
}
}
}
# Функция для поиска в глубину и ширину
(рекурсивно)
sub perebor {
# Для нужд рекурсии надо завести
локальный хеш %isp_form
my ($el,%isp_gr_form)= @_;
my ($cur_sim1,$cur_sig,$cur_sim2,$cur_form);
my $link_to_cur_formula=$arr_output[$el];
# Тут должна быть проверка по условию
вхождения @$link_to_cur_formula[2] и в массив
@total_var
$cur_sim1=@$link_to_cur_formula[2]; # Первый член
формулы
##поиск по первой ветви
if ( exists $total_var{$cur_sim1} ) {
$cur_form = $cur_form.$cur_sim1;
} else {
$cur_form=&branch($cur_sim1,%isp_gr_form); #поиск в
глубену для первого подсимвола
}
# Тут должна быть проверка по условию
вхождения @$link_to_cur_formula[4] и в массив
@total_var
$cur_sig=@$link_to_cur_formula[3]; # Знак
$cur_sim2=@$link_to_cur_formula[4]; # Второй член
формулы
##поиск по второй ветви
if ( exists $total_var{$cur_sim2} ) {
$cur_form = '('.$cur_form . " $cur_sig $cur_sim2)";
return $cur_form; #возвращяем часть формуля
состоящюю из заданных физических
величин искомой формулы
} else {
return $cur_form = $cur_form.&branch($cur_sim2,%isp_gr_form);
#возвращение значения для второго
значения
}
}
##транслятор коммандной строки
print "Vvedite simbol: ";
while($sim_tot=<>){
chomp $sim_tot;
print "\ntotal form0: $sim_tot = ( ";
print "\ntotal form0: ",&branch($sim_tot);
print "\ntotal form0: )\n";
print "Vvedite simbol: ";
}
ignat 99
Есть следующие формулы:
N*Eps0=Q
Tau*l=Q
U*Eps0=Tau
E*l=U
E*Eps0 =Sigma
Tau*U=F
Q*E=F
N*Sigma=F
Даны два заряда Q1 и Q2 , дана длинна l.
Пусть программа, исходя их этих законов выведет формулу:
Eps0*Q1*Q2/(L*L)=F
Рекомендации:
1. формула записывается в виде списка(LIST) примерно такой формы:
[q,=,[n,*,eps0]] - кстати Епсилон нулевое в конце стоит ноль а не буква о
хотя это и не принципиально но все физики это знают.
Соответственно программа должна получить сама следующие списки (LISTS):
[n,=,[q,/,eps0]] - Это значит n равно q разделить на епсилон нулевое.
[eps0,=,[q,/,n]]
2. Значения (числа) сразу подставлять не надо.
Далее на основании этих списков вычисляется формула для F. Например
[F,=,[q,*,e]], но если [e,=,[u,/,l]] и у нас задано q и l и u то конечная
формула будет [F,=,[q,*,[u,/,l]]].
Её и надо _вывести_ на печать.
3. Основной момент надо предотвратить зацикливание программы при
подстановке,
============================================================
============================================================
ignat
ign...@gmail.com
###Program on Perl lang for translation physical quantity (any simbol
from @arr_input) to formula of different physical quantities
(%total_var)
##pass source formula
my @arr_input = (
['Q','=','N','*','Eps0'],
[ qw(Q = Tau * l) ],
['Tau','=','U','*','Eps0'],
['U','=','E','*','l'],
['Sigma','=','E','*','Eps0'],
# ['F','=','Tau','*','U'],
# ['F','=','E','*','Q'],
['F','=','N','*','Sigma']
);
##pass physical quantities
my %total_var=('Q' => 1,'l'=> 1, 'Eps0' => 1);
#my %total_var=('N' => 1, 'Sigma' => 1);
my @arr_output = ();
###this function realised replacement symbol '*' to '/' and back, then
we form source massiv (@arr_input) output massiv (@arr_output)
sub flip_operation {
my $sim=shift;
if ($sim eq '*') { $sim='/';}
elsif ($sim eq '/') { $sim='*';}
else {die "Parsing error !!!\n";}
}
###this function converted source massiv by transposition rows of
massiv.
sub make_arr_output {
my @cur_arr= @_; #award @cur_arr to @arr_input
my @tmp_formula; #massiv in wich we'll store received
foreach my $cur_line ( @cur_arr) { #hendel source massiv, go through
each element
push (@arr_output,[@$cur_line]); #put into @arr_otput rows from
handeled massiv
push(@tmp_formula,@$cur_line[2],@$cur_line[1],@$cur_line[0],
flip_operation(@$cur_line[3]),@$cur_line[4]); # in the first row of
@tmp_formula put @$cur_line[2] wich corresponding with third row of
@cur_arr massiv, then to the second row of @tmp_formula put
@$cur_line[1], wich corresponding with symbol "=" and so on, in sach a
way we get expression of the second element from source formula
push (@arr_output,[@tmp_formula]); # write resualt to @arr_output
@tmp_formula=(); # clear massiv
push(@tmp_formula,@$cur_line[4],@$cur_line[1],@$cur_line[0],
flip_operation(@$cur_line[3]),@$cur_line[2]); #do the sane think with
therd argument
push (@arr_output,[@tmp_formula]); # add to output massiv
@tmp_formula=(); # again clear massiv
}
}
###run function with argument
&make_arr_output(@arr_input);
my @isp_form=();
my %isp_gr_form=();
###this function search group number from formula number
sub group_number {
##A group of formula means this: Q=N*Eps0, N=Q\Eps0 Рё Eps0=Q\N.
my $chis=shift;
my $n = int ($chis/3);
return $n;
}
### serach formula function(It base on input elements)
sub search_number_of_formula {
my ($simbol1,$simbol2,$simbol3)=@_; #pass arguments
my @isp_form; #massiv of used formuls
my $i=0;
my @search_condition; #massiv og usefll elements
my ($cur_iter1,$cur_iter2,$cur_iter3);
#print "Sim: $simbol1\n";
##get condition of searching
if (defined $simbol1) { push (@search_condition, '$cur_iter1 eq
$simbol1'); }
else {die "Simbol1 not defined : $! \n";}
if (defined $simbol2) { push (@search_condition, '$cur_iter2 eq
$simbol2'); }
if (defined $simbol3) { push (@search_condition, '$cur_iter3 eq
$simbol3'); }
foreach my $iter (@arr_output){
##go through
$cur_iter1 = @$iter[0]; #$cur_iter1 get first meaning
$cur_iter2 = @$iter[2]; # --#--
$cur_iter3 = @$iter[4];
if (
eval (join ( " and ", @search_condition) ) #execution of given
condition
) {
push (@isp_form,$i);#push in massiv number of finded formula
} else {
}
$i++;
}
return @isp_form; #return the massiv
}
#search corollary formula, infil hash, call recursion for each new
group
sub branch {
my($b_el,%isp_gr_form)=@_; #passing physical quantities and hash
with numbers of group
my(@poisk_v_shir1,$cur_gr,$cur_form); #massiv for finded
formuls(group of formuls)
##start searching formula
if ( exists $total_var{$b_el} ) { return $b_el;} #cheking up
operation
@poisk_v_shir1=&search_number_of_formula($b_el); #searching
corollary formula
##running over all formuls, finded for symbol
foreach my $f_num_1 (@poisk_v_shir1) {
$cur_gr=&group_number($f_num_1); #computation number group
##if the group of formuls is already used, go on
unless ( exists $isp_gr_form{$cur_gr}) {
$isp_gr_form{$cur_gr}++;
$cur_form=&perebor($f_num_1,%isp_gr_form); #searching deep from
the tree of formuls
return $cur_form; #return computated formula
} else {
$isp_gr_form{$cur_gr}++;
}
}
}
#Deep searching function
sub perebor {
#recursion deman's local hash
my ($el,%isp_gr_form)= @_;
my ($cur_sim1,$cur_sig,$cur_sim2,$cur_form);
my $link_to_cur_formula=$arr_output[$el];
$cur_sim1=@$link_to_cur_formula[2]; # First argument
##searching for the first branch
if ( exists $total_var{$cur_sim1} ) {
$cur_form = $cur_form.$cur_sim1;
} else {
$cur_form=&branch($cur_sim1,%isp_gr_form); #deep searching for the
first argument
}
$cur_sig=@$link_to_cur_formula[3];
$cur_sim2=@$link_to_cur_formula[4]; # second argument
##searching for the second branch
if ( exists $total_var{$cur_sim2} ) {
$cur_form = '('.$cur_form . " $cur_sig $cur_sim2)";
return $cur_form; #return part of given physical quantities of
requaied formula
} else {
return $cur_form = $cur_form.&branch($cur_sim2,%isp_gr_form);
}
}
##comand line assembler