$TRANSLATE / Caché, Ensemble, DeepSee, MiniM, IRIS, GT.M

Участник

Откуда: Беларусь, Минск

Сообщения: 950

Рейтинг: 0 / 0

Еще

Код: plaintext

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.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.

%ztest(TD)
 s TDMIN= 1 , TDMAX= 12 , TD=$G(TD,TDMAX) 
 s:(TD<TDMIN)||(TD>TDMAX) TD=TDMAX
 
 s str( 1 )="111222222222222222222222222",replace( 1 )="11122",with( 1 )="111"
 s str( 2 )="",replace( 2 )="11122",with( 2 )="111"
 s str( 3 )="111222222222222222222222222"
  ,replace( 3 )="11122"
  ,with( 3 )="999999999999999999999999999999999999"
 s str( 4 )="111222222222222222222222222"
  ,replace( 4 )="111222222222222222222222222"
  ,with( 4 )="111222222222222222222222222"
 
 ;необратимые изменения
 s str( 5 )="11122"
  ,replace( 5 )="111222222222222222222222222"
  ,with( 5 )="111"
 s str( 6 )="111222222222222222222222222"
  ,replace( 6 )="999999999999999999999999999999999999"
  ,with( 6 )="111"
 s str( 7 )="111222222222222222222222222",replace( 7 )="11122",with( 7 )=""
 s str( 8 )="111222222222222222222222222",replace( 8 )="",with( 8 )="111"
 s str( 9 )="",replace( 9 )="",with( 9 )="111"
 s str( 10 )="112221133311444",replace( 10 )="11",with( 10 )=""
 
 ; на длинные строки
 s str( 11 )=$j( 0 , 1000 ),replace( 11 )="  ", with( 11 )="1" 
 s str( 12 )=$j( 0 , 1000 ),replace( 12 )="  ", with( 12 )=""
 
 s N= 1000 , $zt="funerr",test= 1 
 
 ;s file="с:\test.log" o file:"WNU" u file
 f fun="$replace","$$TransShu","$$TransDF","$$strrep" { ;,"$$TransShu",
  f td=TDMIN: 1 :TD {
   s Str=str(td),Sub1=replace(td),Sub2=with(td)   
   s forward=fun_"("""_Str_""","""_Sub1_""","""_Sub2_""")"
   s backward=fun_"("_forward_","""_Sub2_""","""_Sub1_""")"
   s cmd(td)="test=test&("""_Str_"""="_backward_")"
   ;w !,"test=test&("""_Str_"""="_backward_")"
  }
  
  s cmd="test=1" s @cmd
  s t0=$zh
  f td=TDMIN: 1 :TD {
   f ni= 1 : 1 :N {
    s @cmd(td)
   }
   ;w !,test,": ",cmd(td) 
  } 
  s t1=$zh
  w !,fun,? 20 ,$fn((t1-t0)/N,"", 8 ),? 40 ,$s(test:"correct", 1 :"wrong")
 }
 ;c file  
 Q
 
funerr
 s $zt="" w $ze,!
 q

TransShu(Str,Sub1,Sub2) ; (krvsa, ser_shu) В строке Str заменить Sub1 на Sub2
 s Str=$G(Str), Sub1=$G(Sub1), Sub2=$G(Sub2)
 Q:(Str="")||(Sub1="")||(Str'[Sub1)||(Sub1=Sub2) Str 
 N str,i,l s l=$L(Str,Sub1), str=$P(Str,Sub1)
 F i=2:1:l S str=str_Sub2_$P(Str,Sub1,i)
 Q str 

TransDF(Str,Sub1,Sub2)  ; В строке Str заменить Sub1 на Sub2
 s Str=$g(Str),Sub1=$g(Sub1),Sub2=$g(Sub2) 
 Q:(Str="")||(Sub1="")||(Str'[Sub1)||(Sub1=Sub2) Str 
 n str,l,i,fl s str="",l=$L(Str,Sub1),fl=$l(Sub2)
 if fl F i= 1 : 1 :l s $P(str,Sub2,i)=$P(Str,Sub1,i) 
 e  F i= 1 : 1 :l s str=str_$P(Str,Sub1,i)
 Q str
 
strrep(str,replace,with) ; (ISC, AM)
 n pos,bTr,cc
 q:$g(str)=""||($g(replace)="") str
 s with=$g(with),pos= 0 ,bTr= 0 
 if with="" {
	 for cc= 0 : 1 : 255  {
		 if '$f(str,$c(cc)) set with=$c(cc),bTr=1 quit
		 if cc=255 g loopex
	 }
 }
loop Set pos=$find(str,replace,pos) g:'pos loopex Set str=$extract(str, 1 ,pos-$length(replace)- 1 )_with_$extract(str,pos,*) Set pos=pos+($length(with)-$length(replace)) Goto loop
loopex
 if bTr s str=$tr(str,with,"")
 q str

...

Рейтинг:

0 / 0

28.07.2010, 15:33

| Ответить | Цитировать | Написать

$TRANSLATE

#36764232

Участник

Откуда: Беларусь, Минск

Сообщения: 950

Рейтинг: 0 / 0

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.

USER>d ^Trans( 4 )
 
$replace             0 . 00000727           correct
$$TransShu           0 . 00003709           correct
$$TransDF            0 . 00004109           correct
$$strrep             0 . 00003775           correct
USER>d ^Trans( 10 )
 
$replace             0 . 00001428           wrong
$$TransShu           0 . 00008810           wrong
$$TransDF            0 . 00007481           wrong
$$strrep             0 . 00005003           wrong
USER>d ^Trans
 
$replace             0 . 00012775           wrong
$$TransShu           0 . 00483602           wrong
$$TransDF            0 . 00964310           wrong
$$strrep             0 . 00196663           wrong

...

Рейтинг:

0 / 0

28.07.2010, 15:35

| Ответить | Цитировать | Написать

$TRANSLATE

#36764433

Участник

Откуда: Беларусь, Минск

Сообщения: 950

Рейтинг: 0 / 0

"Левый" $P проигрывает обычному + сцепка. Посмотрим, что будет с "левым" $E.

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.

krvsa(fun)  ;проверки от krvsa Батьковича
  n Str,Sub1,Sub2,test,cmd
  s test= 1 ,Str="114444411333333118888",Sub1="11",Sub2="22"
  s cmd="test=test&("_fun_"(Str,Sub1,Sub2)=$replace(Str,Sub1,Sub2))"
  s @cmd ;w !,cmd," : ",test
  s Str="114444411333333118888",Sub1="11",Sub2="22"
  s @cmd ;w !,cmd," : ",test
  s Str="112221133311444",Sub1="11",Sub2=""
  s @cmd ;w !,cmd," : ",test
 Q test

Добавим их в вывод результатов

Код: plaintext

 w !,fun,? 20 ,$fn((t1-t0)/N,"", 8 ),? 40 ,$s(test:"correct", 1 :"wrong"),$c( 9 ),$$krvsa(fun)

Собственно "левый" $E

Код: plaintext

1.
2.
3.
4.
5.
6.

TransDF(Str,Sub1,Sub2)  ; В строке Str заменить Sub1 на Sub2
 s Str=$g(Str),Sub1=$g(Sub1),Sub2=$g(Sub2) 
 Q:(Str="")||(Sub1="")||(Str'[Sub1)||(Sub1=Sub2) Str 
 n L1,L2,diff,pos s L1=$L(Sub1),L2=$L(Sub2),diff=L2-L1, pos=0  
 F  s pos=$F(Str,Sub1,pos) q:'pos  s $E(Str,pos-L1,pos- 1 )=Sub2, pos=pos+diff
 Q Str

На простом наборе данных

Код: plaintext

1.
2.
3.
4.
5.

USER>d ^Trans( 4 )
$replace             0 . 00000717           correct  1 
$$TransShu           0 . 00003756           correct  1 
$$TransDF            0 . 00003776           correct  1 
$$strrep             0 . 00003822           correct  1

С необратимыми

Код: plaintext

1.
2.
3.
4.
5.

USER>d ^Trans( 9 )
$replace             0 . 00001335           wrong    1 
$$TransShu           0 . 00007615           wrong    1 
$$TransDF            0 . 00006595           wrong    1 
$$strrep             0 . 00003797           wrong    1

И длинные

Код: plaintext

1.
2.
3.
4.
5.

USER>d ^Trans
$replace             0 . 00012810           wrong    1 
$$TransShu           0 . 00492200           wrong    1 
$$TransDF            0 . 00095149           wrong    1 
$$strrep             0 . 00198886           wrong    1

...

Рейтинг:

0 / 0

28.07.2010, 16:36

| Ответить | Цитировать | Написать

$TRANSLATE

#36764488

Участник

Откуда: СПб

Сообщения: 1 668

Рейтинг: 0 / 0

doublefint, если исправить проверку корректности на:

Код: plaintext

s cmd(td)="test=("_forward_"=$replace(Str,Sub1,Sub2))"

, то уйдут ложные "wrong".

...

Рейтинг:

0 / 0

28.07.2010, 16:58

| Ответить | Цитировать | Написать

$TRANSLATE

#36764591

Участник

Откуда: Беларусь, Минск

Сообщения: 950

Рейтинг: 0 / 0

Alexey Maslov, код предложите? ;)
Кстати, не понял зачем подбирать символ, можно без него

Код: plaintext

1.
2.
3.
4.
5.

strrep(Str,Sub1,Sub2) ; (ISC, AM)
 s Str=$g(Str),Sub1=$g(Sub1),Sub2=$g(Sub2) Q:(Str="")||(Sub1="")||(Str'[Sub1)||(Sub1=Sub2) Str 
 n pos,L1,L2,delta s pos=0, L1=$l(Sub1), L2=$l(Sub2),delta=L2-L1
loop Set pos=$F(Str,Sub1,pos) Q:'pos Str Set Str=$E(Str, 1 ,pos-L1- 1 )_Sub2_$E(Str,pos,*), pos=pos+delta 
 Goto loop

$Replace - хорошая функция, жалко сразу не было :)

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.

USER>d ^Trans( 4 )
 
$replace             0 . 00000707           correct  1 
$$TransShu           0 . 00002006           correct  1 
$$TransDF            0 . 00001793           correct  1 
$$strrep             0 . 00001726           correct  1 
USER>d ^Trans( 9 )
 
$replace             0 . 00001323           wrong    1 
$$TransShu           0 . 00003990           wrong    1 
$$TransDF            0 . 00003619           wrong    1 
$$strrep             0 . 00003612           wrong    1

Длинные строки

Код: plaintext

1.
2.
3.
4.
5.
6.

USER>d ^Trans
 
$replace             0 . 00006806           wrong    1 
$$TransShu           0 . 00478307           wrong    1 
$$TransDF            0 . 00095102           wrong    1 
$$strrep             0 . 00192940           wrong    1

...

Рейтинг:

0 / 0

28.07.2010, 17:33

| Ответить | Цитировать | Написать

$TRANSLATE

#36764621

Участник

Откуда: Беларусь, Минск

Сообщения: 950

Рейтинг: 0 / 0

Еще раз итого:

Код: plaintext

%ztest(TD) ;TD - по какой тест
 s TDMIN= 1 , TDMAX= 12 , TD=$G(TD,TDMAX) s:(TD<TDMIN)||(TD>TDMAX) TD=TDMAX
 
 s str( 1 )="111222222222222222222222222",replace( 1 )="11122",with( 1 )="111"
 s str( 2 )="",replace( 2 )="11122",with( 2 )="111"
 s str( 3 )="111222222222222222222222222",replace( 3 )="11122"
  ,with( 3 )="999999999999999999999999999999999999"
 s str( 4 )="111222222222222222222222222",replace( 4 )="111222222222222222222222222"
  ,with( 4 )="111222222222222222222222222"
 
 ;необратимые изменения
 s str( 5 )="11122", replace( 5 )="111222222222222222222222222",with( 5 )="111"
 s str( 6 )="111222222222222222222222222",replace( 6 )="999999999999999999999999999999999999"
  ,with( 6 )="111"
 s str( 7 )="111222222222222222222222222",replace( 7 )="11122",with( 7 )=""
 s str( 8 )="111222222222222222222222222",replace( 8 )="",with( 8 )="111"
 s str( 9 )="",replace( 9 )="",with( 9 )="111"
 s str( 10 )="112221133311444",replace( 10 )="11",with( 10 )=""
 
 ; на длинные строки
 s str( 11 )=$j( 0 , 1000 ),replace( 11 )="  ", with( 11 )="1" 
 s str( 12 )=$j( 0 , 1000 ),replace( 12 )="  ", with( 12 )=""
 
 s N= 10000 , $zt="funerr",test= 1 
 
 ;s file="с:\test.log" o file:"WNU" u file
 f fun="$replace","$$TransShu","$$TransDF","$$strrep" { 
  s test= 1 , cmd="test=("_fun_"(Str,Sub1,Sub2)=$replace(Str,Sub1,Sub2))", t0=$zh
  f td=TDMIN: 1 :TD {
   s Str=str(td),Sub1=replace(td),Sub2=with(td)   
   f ni= 1 : 1 :N { s @cmd }
   ;w !,test,": ",cmd(td) 
  } 
  s t1=$zh
  w !,fun,? 20 ,$fn((t1-t0)/N,"", 8 ),? 40 ,$s(test:"correct", 1 :"wrong"),$c( 9 ),$$krvsa(fun)
 }
 ;c file  
 Q

funerr  s $zt="" w $ze,! Q

TransShu(Str,Sub1,Sub2) ; (krvsa, ser_shu) В строке Str заменить Sub1 на Sub2
 s Str=$G(Str), Sub1=$G(Sub1), Sub2=$G(Sub2) Q:(Str="")||(Sub1="")||(Str'[Sub1)||(Sub1=Sub2) Str 
 N str,i,l s l=$L(Str,Sub1), str=$P(Str,Sub1) F i=2:1:l S str=str_Sub2_$P(Str,Sub1,i)
 Q str 

TransDF(Str,Sub1,Sub2)  ; В строке Str заменить Sub1 на Sub2
 s Str=$g(Str),Sub1=$g(Sub1),Sub2=$g(Sub2) Q:(Str="")||(Sub1="")||(Str'[Sub1)||(Sub1=Sub2) Str 
 n L1,L2,diff,pos s L1=$L(Sub1),L2=$L(Sub2),diff=L2-L1, pos= 0   
 F  s pos=$F(Str,Sub1,pos) q:'pos  s $E(Str,pos-L1,pos-1)=Sub2, pos=pos+diff
 Q Str

strrep(Str,Sub1,Sub2) ; (ISC, AM)
 s Str=$g(Str),Sub1=$g(Sub1),Sub2=$g(Sub2) Q:(Str="")||(Sub1="")||(Str'[Sub1)||(Sub1=Sub2) Str 
 n pos,L1,L2,delta s pos= 0 , L1=$l(Sub1), L2=$l(Sub2),delta=L2-L1
loop Set pos=$F(Str,Sub1,pos) Q:'pos Str Set Str=$E(Str, 1 ,pos-L1- 1 )_Sub2_$E(Str,pos,*), pos=pos+delta Goto loop

krvsa(fun) ;)
  n Str,Sub1,Sub2,test,cmd 
  s test= 1 ,Str="114444411333333118888",Sub1="11",Sub2="22"
  s cmd="test=test&("_fun_"(Str,Sub1,Sub2)=$replace(Str,Sub1,Sub2))" s @cmd ;w !,cmd," : ",test
  s Str="114444411333333118888",Sub1="11",Sub2="22" s @cmd ;w !,cmd," : ",test
  s Str="112221133311444",Sub1="11",Sub2="" s @cmd ;w !,cmd," : ",test
 Q test

...

Рейтинг:

0 / 0

28.07.2010, 17:47

| Ответить | Цитировать | Написать

$TRANSLATE

#36764686

Участник

Откуда: СПб

Сообщения: 1 668

Рейтинг: 0 / 0

Если улучшенный Вами алгоритм $$strrep перевести на левую $E(), то он снова выйдет в лидеры (2-6% ускорения, в зависимости от длины строки):

Код: plaintext

1.
2.
3.
4.

strrep(Str,Sub1,Sub2) public { ; (ISC, AM)
 s Str=$g(Str),Sub1=$g(Sub1),Sub2=$g(Sub2) Q:(Str="")||(Sub1="") Str 
 s pos= 0 , L1=$l(Sub1), delta=$l(Sub2)-L1
loop Set pos=$F(Str,Sub1,pos) Q:'pos Str s $E(Str,pos-L1,pos- 1 )=Sub2, pos=pos+delta Goto loop
}

Причины: отсутствие лишних проверок, goto vs. for, и бОльшая эффективность процедур по ср. с "классическими" функциями.
Действительно, $replace() хорошая функция (и она может больше, см. док-ю). Есть плюсы и у оригинальной $$strrep() от ISC: она умеет оставлять нетронутыми закавыченные строки.
А вот что не очень обрадовало, так это резкое замедление скорости работы $E() на строках длиннее 10000. Линейное замедление (как функцию длины строки) показывает только $replace (которая, очевидно, не на COSе писана ;).

...

Рейтинг:

0 / 0

28.07.2010, 18:10

| Ответить | Цитировать | Написать

$TRANSLATE

#36764783

ну я

Участник

Откуда: Москва

Сообщения: 1 270

Рейтинг: 0 / 0

Alexey MaslovЧто-то мне подсказывает, что для необратимых изменений нужна другая проверка корректности...
В приведенном Вами коде проверки корректности неверна методика в части сравнения строк до и после замены.
Например была строка str="222". После замены подстроки "111" на "222" получим ту же "222", и при обратной замене "222" на "111" получим "111", что не есть исходная строка.

...

Рейтинг:

0 / 0

28.07.2010, 18:37

| Ответить | Цитировать | Написать

$TRANSLATE

#36765252

Sergei Obrastsov

Участник

Откуда: Магадан

Сообщения: 585

Рейтинг: 0 / 0

Alexey MaslovПричины: отсутствие лишних проверок, goto vs. for, и бОльшая эффективность процедур по ср. с "классическими" функциями.
Вы серьезно полагаете, что GOTO эффективней по скорости, чем FOR? :)

...

Рейтинг:

0 / 0

29.07.2010, 01:22

| Ответить | Цитировать | Написать

$TRANSLATE

#36765267

Участник

Откуда: LIBAVA

Сообщения: 526

Рейтинг: 0 / 0

Alexey Maslov,

r(str,s1,s2)
s L=$lfs(str,s1),new=""
f i=1:1:$ll(L) s new=new_$lg(L,i)_s2
q $e(new,1,$l(new)-$l(s2))

работает быстрее чем $Replace

:)

...

Рейтинг:

0 / 0

29.07.2010, 02:00

| Ответить | Цитировать | Написать

$TRANSLATE

#36765382

Участник

Откуда: СПб

Сообщения: 1 668

Рейтинг: 0 / 0

ну я (Евгений :), уже исправлено на сравнение с "эталоном" ($replace). См. выше.

...

Рейтинг:

0 / 0

29.07.2010, 09:04

| Ответить | Цитировать | Написать

$TRANSLATE

#36765421

Участник

Откуда: г. Кишинёв, Республика Молдова

Сообщения: 3 167

Рейтинг: 0 / 0

MX-9Alexey Maslov,

r(str,s1,s2)
s L=$lfs(str,s1),new=""
f i=1:1:$ll(L) s new=new_$lg(L,i)_s2
q $e(new,1,$l(new)-$l(s2))

работает быстрее чем $Replace

:)Можете привести данные, на которых вы делали этот тест?

...

Рейтинг:

0 / 0

29.07.2010, 09:50

| Ответить | Цитировать | Написать

$TRANSLATE

#36765430

Участник

Откуда: Беларусь, Минск

Сообщения: 950

Рейтинг: 0 / 0

Ок, пробуем:

Код: plaintext

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.

USER>d ^Trans( 4 )
 
$replace             0 . 00000547           correct  1 
$$TransShu           0 . 00001447           correct  1 
$$TransDF            0 . 00000835           correct  1 
$$strrep             0 . 00000823           correct  1 
$$strrep2            0 . 00000891           correct  1 
$$mx9                0 . 00000992           correct  1 

USER>d ^Trans( 9 )
 
$replace             0 . 00001105           correct  1 
$$TransShu           0 . 00001889           correct  1 
$$TransDF            0 . 00001587           correct  1 
$$strrep             0 . 00001537           correct  1 
$$strrep2            0 . 00001865           correct  1 
<MAXSTRING>mx9+ 1 ^Trans

>d ^Trans
 
$replace             0 . 00006799           correct  1 
$$TransShu           0 . 00485270           correct  1 
$$TransDF            0 . 00055118           correct  1 
$$strrep             0 . 00128772           correct  1 
$$strrep2            0 . 00054540           correct  1 
<MAXSTRING>mx9+ 1 ^Trans

...

Рейтинг:

0 / 0

29.07.2010, 09:54

| Ответить | Цитировать | Написать

$TRANSLATE

#36765463

Участник

Откуда: СПб

Сообщения: 1 668

Рейтинг: 0 / 0

Sergei ObrastsovВы серьезно полагаете, что GOTO эффективней по скорости, чем FOR? :)Сам удивился :) Небольшое ускорение есть, ~ 2-6%. По-видимому, засчет того, что в случае FOR нужен лишний QUIT.
MX-9r(str,s1,s2)
s L=$lfs(str,s1),new=""
f i=1:1:$ll(L) s new=new_$lg(L,i)_s2
q $e(new,1,$l(new)-$l(s2))

работает быстрее чем $ReplaceТесты показали, что это не так. Проигрывает даже $$strrep. Я ее привел к "стандартному виду", чтобы не вылетала по <STRINGSTACK>:

Код: plaintext

1.
2.
3.
4.
5.
6.

r(str,s1,s2) public {;MX- 9 
 s str=$g(str),s1=$g(s1),s2=$g(s2) Q:(str="")||(s1="") str
 s L=$lfs(str,s1),new="" 
 f i= 1 : 1 :$ll(L) s new=new_$lg(L,i)_s2
 q $e(new, 1 ,$l(new)-$l(s2))
}

Тестировал на наборе:

Код: plaintext

1.
2.
3.
4.
5.
6.
7.

 s str( 1 )="111222222222222222222222222",replace( 1 )="11122",with( 1 )="111"
 s str( 2 )="123",replace( 2 )="1",with( 2 )="5" ;MX- 9 
 s str( 3 )="112221133311444112221133311444112221133311444112221133311444112221133311444112221133311444"
 s str( 3 )=str( 3 )_str( 3 ),replace( 3 )="11",with( 3 )="" ;krvsa
 s str( 4 )="112221133311444",replace( 4 )="",with( 4 )="111"
 s str( 7 )="111222222222222222222222222",replace( 7 )="11122",with( 7 )=""
 s str( 8 )=str( 3 )_str( 3 )_str( 3 )_str( 3 )_str( 3 ),replace( 8 )="11",with( 8 )=""

Результат:

Код: plaintext

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.

iStr= 1               $l= 27                 111222222222222222222222222   11122   111 
$replace             0 . 00000041            1112222222222222222222222 
$$strrep             0 . 00000227            1112222222222222222222222 
$$strrepfor          0 . 00000236            1112222222222222222222222 
$$r                  0 . 00000255            1112222222222222222222222 
$$strreplist         0 . 00000162            1112222222222222222222222 

iStr= 2               $l= 3                  123   1   5 
$replace             0 . 00000037            523 
$$strrep             0 . 00000204            523 
$$strrepfor          0 . 00000212            523 
$$r                  0 . 00000230            523 
$$strreplist         0 . 00000142            523 

iStr= 3               $l= 180                1122211333114441122211333114441122211333   11 
$replace             0 . 00000178            2223334442223334442223334442223334442223 
$$strrep             0 . 00001326            2223334442223334442223334442223334442223 
$$strrepfor          0 . 00001428            2223334442223334442223334442223334442223 
$$r                  0 . 00001109            2223334442223334442223334442223334442223 
$$strreplist         0 . 00000367            2223334442223334442223334442223334442223 

iStr= 4               $l= 15                 112221133311444    111 
$replace             0 . 00000035            112221133311444 
$$strrep             0 . 00000141            112221133311444 
$$strrepfor          0 . 00000142            112221133311444 
$$r                  0 . 00000142            112221133311444 
$$strreplist         0 . 00000137            112221133311444 

iStr= 7               $l= 27                 111222222222222222222222222   11122 
$replace             0 . 00000042            2222222222222222222222 
$$strrep             0 . 00000231            2222222222222222222222 
$$strrepfor          0 . 00000235            2222222222222222222222 
$$r                  0 . 00000251            2222222222222222222222 
$$strreplist         0 . 00000160            2222222222222222222222 

iStr= 8               $l= 900                1122211333114441122211333114441122211333   11 
$replace             0 . 00000746            2223334442223334442223334442223334442223 
$$strrep             0 . 00006711            2223334442223334442223334442223334442223 
$$strrepfor          0 . 00007236            2223334442223334442223334442223334442223 
$$r                  0 . 00007503            2223334442223334442223334442223334442223 
$$strreplist         0 . 00001165            2223334442223334442223334442223334442223

$$strrep - последний вариант, опубликован выше.
$$strrepfor - он же, goto loop заменена на for.
$$strreplist - можно порекомендовать пользователям Cache 5.1-2007.1, у которых нет $replace. У этого варианта, как и у $replace, линейный рост t_run( $length(str) ):

Код: plaintext

1.
2.
3.

strreplist(Str,Sub1,Sub2) public { ; AM
 s Str=$g(Str),Sub1=$g(Sub1),Sub2=$g(Sub2) Q:(Str="")||(Sub1="") Str
 q $listtostring($listfromstring(Str,Sub1),Sub2)
}

...

Рейтинг:

0 / 0

29.07.2010, 10:09

| Ответить | Цитировать | Написать

$TRANSLATE

#36765526

ser_shu

Гость

krvsa ser_shu , у тебя такое мнение/виденье... У меня такое... Я же тебе своё не навязываю.
доктор, а почему вы все время неприличные картинки рисуете? (с) ;-)

...

Рейтинг:

0 / 0

29.07.2010, 10:28

| Ответить | Цитировать | Написать

$TRANSLATE

#36765581

Участник

Откуда: LIBAVA

Сообщения: 526

Рейтинг: 0 / 0

Alexey Maslov .........
$$strreplist - можно порекомендовать пользователям Cache 5.1-2007.1, у которых нет $replace. У этого варианта, как и у $replace, линейный рост t_run( $length(str) ):

Код: plaintext

1.
2.
3.

strreplist(Str,Sub1,Sub2) public { ; AM
 s Str=$g(Str),Sub1=$g(Sub1),Sub2=$g(Sub2) Q:(Str="")||(Sub1="") Str
 q $listtostring($listfromstring(Str,Sub1),Sub2)
}

------------------------------------------------------

Алексей
мой выпад против $replace был скороспелым

Притом Ваш $$strreplist конечно лучше,
и на новых версиях CACHE его тоже можно применять (с вариациями)
- если нужен болеее специальный $replace

линейная зависимость от длины строки !

...

Рейтинг:

0 / 0

29.07.2010, 10:44

| Ответить | Цитировать | Написать

$TRANSLATE

#36765590

Участник

Откуда: LIBAVA

Сообщения: 526

Рейтинг: 0 / 0

servit,

я тестировал на коротких строках ночью при свете луны
думаю наш {Большой_Тест_DoublelFint} снимает все вопросы
( с учетом поправок Алексея Маслова - $$strreplist )

...

Рейтинг:

0 / 0

29.07.2010, 10:51

| Ответить | Цитировать | Написать

$TRANSLATE

#36765602

Участник

Откуда: Беларусь, Минск

Сообщения: 950

Рейтинг: 0 / 0

Так если подвести итоги:
До версии 5.1

Код: plaintext

1.
2.
3.
4.
5.

replace(Str,Sub1,Sub2) public { ; (ISC, AM)
 s Str=$g(Str),Sub1=$g(Sub1),Sub2=$g(Sub2) Q:(Str="")||(Sub1="") Str 
 s pos= 0 , L1=$l(Sub1), delta=$l(Sub2)-L1
loop Set pos=$F(Str,Sub1,pos) Q:'pos Str s $E(Str,pos-L1,pos- 1 )=Sub2, pos=pos+delta Goto loop
}

От 5.1 до 2007

Код: plaintext

1.
2.
3.
4.

strreplist(Str,Sub1,Sub2) public { ; AM
 s Str=$g(Str),Sub1=$g(Sub1),Sub2=$g(Sub2) Q:(Str="")||(Sub1="") Str
 q $listtostring($listfromstring(Str,Sub1),Sub2)
}

От 2008 и выше $replace

...

Рейтинг:

0 / 0

29.07.2010, 10:57

| Ответить | Цитировать | Написать

$TRANSLATE

#36765627

Участник

Откуда: СПб

Сообщения: 1 668

Рейтинг: 0 / 0

doublefintДо версии 5.1А также - после очевидных правок - для других реализаций MUMPS :)

...

Рейтинг:

0 / 0

29.07.2010, 11:12

| Ответить | Цитировать | Написать

$TRANSLATE

#36765628

Участник

Откуда: г. Кишинёв, Республика Молдова

Сообщения: 3 167

Рейтинг: 0 / 0

Код программы Trans

Код: plaintext

%ztest(TD,CASE= 0 ) ;TD - по какой тест, CASE - учёт регистра (по умолчанию без)
 s TDMIN= 1 , TDMAX= 13 , TD=$G(TD,TDMAX) s:(TD<TDMIN)||(TD>TDMAX) TD=TDMAX
 
 s str( 1 )="111222222222222222222222222",replace( 1 )="11122",with( 1 )="111"
 s str( 2 )="",replace( 2 )="11122",with( 2 )="111"
 s str( 3 )="111222222222222222222222222",replace( 3 )="11122",with( 3 )="999999999999999999999999999999999999"
 s str( 4 )="111222222222222222222222222",replace( 4 )="111222222222222222222222222",with( 4 )="111222222222222222222222222"
 
 ; необратимые изменения
 s str( 5 )="11122", replace( 5 )="111222222222222222222222222",with( 5 )="111"
 s str( 6 )="111222222222222222222222222",replace( 6 )="999999999999999999999999999999999999",with( 6 )="111"
 s str( 7 )="111222222222222222222222222",replace( 7 )="11122",with( 7 )=""
 s str( 8 )="111222222222222222222222222",replace( 8 )="",with( 8 )="111"
 s str( 9 )="",replace( 9 )="",with( 9 )="111"
 s str( 10 )="112221133311444",replace( 10 )="11",with( 10 )=""
 
 ; на длинные строки
 s str( 11 )=$j( 0 , 1000 ),replace( 11 )="  ", with( 11 )="1" 
 s str( 12 )=$j( 0 , 1000 ),replace( 12 )="  ", with( 12 )=""
 
 ; на учёт регистра
 s str( 13 )="AAABBBBBBBBBBBBBBBBBBBBBBBB",replace( 13 )="aaabb",with( 13 )="AAA"
 
 s N= 10000 , $zt="funerr",test= 1 
 
 ;s file="с:\test.log" o file:"WNU" u file
 f fun="$replace","$$TransShu","$$TransDF","$$strrep","$$strrep2","$$mx9","$$strreplist" { 
  s test= 1 , cmd="test=("_fun_"(Str,Sub1,Sub2)=$replace(Str,Sub1,Sub2,,,CASE))", t0=$zh
  f td=TDMIN: 1 :TD {
   s Str=str(td),Sub1=replace(td),Sub2=with(td)   
   f ni= 1 : 1 :N { s @cmd }
   ;w !,test,": ",cmd(td) 
  } 
  s t1=$zh
  w fun,? 20 ,$fn((t1-t0)/N,"", 8 ),? 40 ,$s(test:"correct", 1 :"wrong"),$c( 9 ),$$krvsa(fun),!
 }
 ;c file  
 Q

funerr  s $zt="" w $ze,! Q

TransShu(Str,Sub1,Sub2) ; (krvsa, ser_shu) В строке Str заменить Sub1 на Sub2
 s Str=$G(Str), Sub1=$G(Sub1), Sub2=$G(Sub2) Q:(Str="")||(Sub1="")||(Str'[Sub1)||(Sub1=Sub2) Str 
 N str,i,l s l=$L(Str,Sub1), str=$P(Str,Sub1) F i=2:1:l S str=str_Sub2_$P(Str,Sub1,i)
 Q str 

TransDF(Str,Sub1,Sub2)  ; В строке Str заменить Sub1 на Sub2
 s Str=$g(Str),Sub1=$g(Sub1),Sub2=$g(Sub2) Q:(Str="")||(Sub1="")||(Str'[Sub1)||(Sub1=Sub2) Str 
 n L1,L2,diff,pos s L1=$L(Sub1),L2=$L(Sub2),diff=L2-L1, pos= 0   
 F  s pos=$F(Str,Sub1,pos) q:'pos  s $E(Str,pos-L1,pos-1)=Sub2, pos=pos+diff
 Q Str

strrep(Str,Sub1,Sub2) ; (ISC, AM)
 s Str=$g(Str),Sub1=$g(Sub1),Sub2=$g(Sub2) Q:(Str="")||(Sub1="")||(Str'[Sub1)||(Sub1=Sub2) Str 
 n pos,L1,L2,delta s pos= 0 , L1=$l(Sub1), L2=$l(Sub2),delta=L2-L1
loop Set pos=$F(Str,Sub1,pos) Q:'pos Str Set Str=$E(Str,1,pos-L1-1)_Sub2_$E(Str,pos,*), pos=pos+delta Goto loop

strrep2(Str,Sub1,Sub2) public { ; (ISC, AM)
 s Str=$g(Str),Sub1=$g(Sub1),Sub2=$g(Sub2) Q:(Str="")||(Sub1="") Str 
 s pos=0, L1=$l(Sub1), delta=$l(Sub2)-L1
loop Set pos=$F(Str,Sub1,pos) Q:'pos Str s $E(Str,pos-L1,pos- 1 )=Sub2, pos=pos+delta Goto loop
}
krvsa(fun) ;)
  n Str,Sub1,Sub2,test,cmd 
  s test= 1 ,Str="114444411333333118888",Sub1="11",Sub2="22"
  s cmd="test=test&("_fun_"(Str,Sub1,Sub2)=$replace(Str,Sub1,Sub2,,,CASE))" s @cmd ;w !,cmd," : ",test
  s Str="114444411333333118888",Sub1="11",Sub2="22" s @cmd ;w !,cmd," : ",test
  s Str="112221133311444",Sub1="11",Sub2="" s @cmd ;w !,cmd," : ",test
  ;s Str="AAABBBBBBBBBBBBBBBBBBBBBBBB",Sub1="aaabb",Sub2="AAA" s @cmd ;w !,cmd," : ",test
	Q test
 
mx9(str,s1,s2) public {;MX- 9 
 s str=$g(str),s1=$g(s1),s2=$g(s2) Q:(str="")||(s1="") str
 s L=$lfs(str,s1),new="" 
 f i= 1 : 1 :$ll(L) s new=new_$lg(L,i)_s2
 q $e(new, 1 ,$l(new)-$l(s2))
}

strreplist(Str,Sub1,Sub2) public { ; AM
 s Str=$g(Str),Sub1=$g(Sub1),Sub2=$g(Sub2) Q:(Str="")||(Sub1="") Str
 q $listtostring($listfromstring(Str,Sub1),Sub2)
}

Результаты (для версии 2010.2.FT5):

Код: plaintext

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.

TEST>d ^Trans(4)
$replace            0.00000169          correct 1
$$TransShu          0.00000577          correct 1
$$TransDF           0.00000577          correct 1
$$strrep            0.00000604          correct 1
$$strrep2           0.00000584          correct 1
$$mx9               0.00000610          correct 1
$$strreplist        0.00000446          correct 1
 
TEST>d ^Trans(9)
$replace            0.00000338          correct 1
$$TransShu          0.00001089          correct 1
$$TransDF           0.00001091          correct 1
$$strrep            0.00001087          correct 1
$$strrep2           0.00001180          correct 1
$$mx9               0.00001283          correct 1
$$strreplist        0.00000938          correct 1
 
TEST>d ^Trans
$replace            0.00005643          correct 1
$$TransShu          0.00246709          correct 1
$$TransDF           0.00037385          correct 1
$$strrep            0.00151274          correct 1
$$strrep2           0.00036137          correct 1
$$mx9               0.00050250          correct 1
$$strreplist        0.00006519          correct 1

MX-9 ,

Cпасибо.

...

Рейтинг:

0 / 0

29.07.2010, 11:12

| Ответить | Цитировать | Написать

$TRANSLATE

#36765656

Участник

Откуда: г. Кишинёв, Республика Молдова

Сообщения: 3 167

Рейтинг: 0 / 0

Код: plaintext

%ztest(TD,CASE= 0 ) ;TD - по какой тест,CASE - учёт регистра (по умолчанию без)

заменить на

Код: plaintext

%ztest(TD,CASE= 0 ) ;TD - по какой тест,CASE - учёт регистра (по умолчанию с)

...

Рейтинг:

0 / 0

29.07.2010, 11:26

| Ответить | Цитировать | Написать

$TRANSLATE

#36765673

Участник

Откуда: LIBAVA

Сообщения: 526

Рейтинг: 0 / 0

а все-таки она вертится ..

$$strreplist быстрее чем $replace

иногда ..

====================================

TRF>d %ztest^test(11)

$replace 0.00004648 correct 1
$$TransShu 0.00167378 correct 1
$$TransDF 0.00019303 correct 1
$$strrep 0.00078926 correct 1
$$strreplist 0.00004613 correct 1

...

Рейтинг:

0 / 0

29.07.2010, 11:31

| Ответить | Цитировать | Написать

$TRANSLATE

#36765719