powered by simpleCommunicator - 2.0.60     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Caché, Ensemble, DeepSee, MiniM, IRIS, GT.M [игнор отключен] [закрыт для гостей] / $TRANSLATE
25 сообщений из 82, страница 2 из 4
$TRANSLATE
    #36762430
doublefint
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Кто пополнит тестовый набор?
Код: plaintext
1.
2.
3.
4.
5.
Trans(Str,Sub1,Sub2)  ; В строке Str заменить Sub1 на Sub2
 s Str=$g(Str),Sub1=$g(Sub1),Sub2=$g(Sub2) 
 Q:(Str="")||(Sub1="")||(Str'[Sub1)||(Sub1=Sub2) Str
 F  q:Str'[Sub1  s Str=$P(Str,Sub1)_Sub2_$P(Str,Sub1, 2 ,$L(Str,Sub1))
 Q Str
...
Рейтинг: 0 / 0
$TRANSLATE
    #36762516
Фотография krvsa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
doublefintпотестил :(
Кащея сейчас под рукой нет... Проверь как отработает твоя функция на таком примере

Код: plaintext
w $$Trans( 111222222222222222222222222 , 11122 , 111 )
...
Рейтинг: 0 / 0
$TRANSLATE
    #36762544
Alexey Maslov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Вариант от ISC (взятый из %stringreplace.inc и слегка подрихтованный) оказался самым быстрым из COSовских: продолжение темы "$piece vs ($find & $extract)".
Код: 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.
%ztest
 s str="АБВрпыАБВффвАБВыфыфыАБВфыфыфАБВыфыфыфыфыАБВфыфыфыфыАБВфыфыфыфыфАБВАБВАБВАБВфыфыфыфыфыфыфыфыфыфыфыфАБВфыфыфыАБВАБВАБВАБВфыфыфыфыфыфыфыфыАБВАБВАБВфыфыфыфыАБВАБВыфыфыфыфыфыфыфыфыфыАБВфыфыфыфыфыфыфыАБВыфыфыфыфыфАБВАБВ"
 s N= 10000 
 s nSub=$l(str,"АБВ")
 f fun="$$TransShu","$$TransDF","$$strrep","$replace" {
  s call="str1="_fun_"(str,""АБВ"",""ЮЯ"")"
  s checkcall="str2="_fun_"(str1,""ЮЯ"",""АБВ"")"
  s t0=$zh
  f i= 1 : 1 :N s @call
  s t1=$zh
  s @checkcall
  w fun,? 20 ,$fn((t1-t0)/N,"", 8 ),? 40 ,$s(str2=str:"correct", 1 :"wrong"),!
 }
 q
TransShu(Str,Sub1,Sub2) ; (krvsa, ser_shu) В строке Str заменить Sub1 на Sub2
 N str,i,lSub1
 s Str=$G(Str)
 s Sub1=$G(Sub1)
 s Sub2=$G(Sub2)
 Q:Str'[Sub1 Str
 S lSub1=$L(Str,Sub1)
 S str=$P(Str,Sub1)
 F i=2:1:lSub1 S str=str_Sub2_$P(Str,Sub1,i)
 Q str 
TransDF(Str,Sub1,Sub2)  ; (doublefint) В строке Str заменить Sub1 на Sub2
 s Str=$g(Str),Sub1=$g(Sub1),Sub2=$g(Sub2) 
 Q:(Str="")||(Sub1="")||(Str'[Sub1)||(Sub1=Sub2) Str
 F  q:Str'[Sub1  s Str=$P(Str,Sub1)_Sub2_$P(Str,Sub1,2,$L(Str,Sub1))
 Q Str 
strrep(str,replace,with) public { ; (ISC, AM)
 q:$g(str)=""||($g(replace)="") str
 s with=$g(with)
 Set pos=0
loop Set pos=$find(str,replace,pos) QUIT:'pos str GOTO loop Set str=$extract(str, 1 ,pos-$length(replace)- 1 )_with_$extract(str,pos,*),pos=pos+($length(with)-$length(replace)) Goto loop
}
...
Рейтинг: 0 / 0
$TRANSLATE
    #36762564
Alexey Maslov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Cлегка подправил "драйвер тестов". Вариант от doublefint на примере krvsa вылетает по <MAXSTRING>.
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
%ztest
 s str="111222222222222222222222222",replace="11122",with="111"
 s N= 10000 
 f fun="$$TransShu","$$strrep","$replace","$$TransDF" {
   s $zt="funerr"
   s call="str1="_fun_"(str,"""_replace_""","""_with_""")"
   s checkcall="str2="_fun_"(str1,"""_with_""","""_replace_""")"
   s t0=$zh
   f i= 1 : 1 :N s @call
   s t1=$zh
   s @checkcall
   w fun,? 20 ,$fn((t1-t0)/N,"", 8 ),? 40 ,$s(str2=str:"correct", 1 :"wrong"),!
   continue
 }
funerr
 s $zt="" w $ze,!
 q
...
Рейтинг: 0 / 0
$TRANSLATE
    #36762593
doublefint
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
krvsa, спасибо :( Без внутренней переменной тяжело...
...
Рейтинг: 0 / 0
$TRANSLATE
    #36762803
doublefint
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Еще
Код: 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.
%ztest(TD)
 s TD=$G(TD, 9 ) s:(TD< 1 )||(TD> 9 ) TD= 9 
 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 N= 10000 , $zt="funerr",test= 1 
 
 ;s file="с:\test.log" o file:"WNU" u file
 f fun="$replace","$$TransShu","$$TransDF","$$strrep" {
  f td= 1 : 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= 1 : 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
 N str,i,lSub1
 s Str=$G(Str)
 s Sub1=$G(Sub1)
 s Sub2=$G(Sub2)
 Q:Str'[Sub1 Str
 S lSub1=$L(Str,Sub1)
 S str=$P(Str,Sub1)
 F i=2:1:lSub1 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,i s str="",i=$L(Str,Sub1)
 F  s $P(str,Sub2,i)=$P(Str,Sub1,i),i=i- 1  q:i= 1 
 Q str
strrep(str,replace,with) public { ; (ISC, AM)
 q:$g(str)=""||($g(replace)="") str
 s with=$g(with),pos= 0 
loop Set pos=$find(str,replace,pos) QUIT:'pos str GOTO loop Set str=$extract(str, 1 ,pos-$length(replace)- 1 )_with_$extract(str,pos,*),pos=pos+($length(with)-$length(replace)) Goto loop
}
...
Рейтинг: 0 / 0
$TRANSLATE
    #36762805
doublefint
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Результаты :)
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
USER>d %ztest^Trans( 4 )
 
$replace             0 . 00000708           correct
$$TransShu           0 . 00002370           correct
$$TransDF            0 . 00001669           correct
$$strrep             0 . 00001355           correct

USER>d %ztest^Trans( 9 )
 
$replace             0 . 00001307           wrong
$$TransShu           0 . 00004166           wrong
$$TransDF            0 . 00003468           wrong
$$strrep             0 . 00003084           correct
...
Рейтинг: 0 / 0
$TRANSLATE
    #36762812
doublefint
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
$$strrep - не умеет заменять на ""
...
Рейтинг: 0 / 0
$TRANSLATE
    #36762989
doublefint
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Модификация
Код: plaintext
1.
2.
3.
4.
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 s str="",l=$L(Str,Sub1),i= 1  F  s $P(str,Sub2,i)=$P(Str,Sub1,i),i=$i(i) q:i=l
 Q str
Результат:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
>d %ztest^Trans
 
$replace             0 . 00001321           wrong
$$TransShu           0 . 00004178           wrong
$$TransDF            0 . 00003191           wrong
$$strrep             0 . 00003197           correct

...
Рейтинг: 0 / 0
$TRANSLATE
    #36763037
Turk
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Вот мой код, которым я часто пользуюсь. (Скорость как-то не было необходимости тестировать, а вот с корректностью работы проблем пока не возникало.)
Код: 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.
#; Заменяет в строке Text все вхождения подстроки FromText на ToText
#; IgnoreCase - признак учета регистра символов ( 0  - учитывать регистр,  1  - не учитывать)
ReplaceStr(AText,AFromText,AToText,AIgnoreCase= 0 ) PUBLIC
{
	q:(AFromText="") AText
	#;
	s res = AText
	#;
	if (AIgnoreCase)
	{
		s AText = $zcvt(AText,"L")
		s AFromText = $zcvt(AFromText,"L")
	}
	#;
	s lenFromText = $l(AFromText)
	s lenToText = $l(AToText)
	#;
	s (posText0, posRes0) =  1 
	f {
		s posText2 = $f(AText,AFromText,posText0)
		q:(posText2= 0 )
		#;
		s posText1 = posText2 - lenFromText
		s deltaPos = posText1 - posText0
		#;
		s posRes1 = posRes0 + deltaPos
		#;
		s $e(res, posRes1, posRes1+lenFromText- 1 ) = AToText
		#;
		s posRes0 = posRes1 + lenToText
		s posText0 = posText2
	}
	#;
	q res
}
...
Рейтинг: 0 / 0
$TRANSLATE
    #36763040
doublefint
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Еще ошибка, сорри :(
Код: 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 str,l,i s str="",l=$L(Str,Sub1)
 F i= 1 : 1 :l s $P(str,Sub2,i)=$P(Str,Sub1,i)
 Q str
Итого:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
USER>d %ztest^Trans( 4 )
 
$replace             0 . 00000725           correct
$$TransShu           0 . 00002605           correct
$$TransDF            0 . 00001871           correct
$$strrep             0 . 00001448           correct

USER>d %ztest^Trans
 
$replace             0 . 00001338           wrong
$$TransShu           0 . 00004385           wrong
$$TransDF            0 . 00003941           wrong
$$strrep             0 . 00003201           correct
...
Рейтинг: 0 / 0
$TRANSLATE
    #36763159
Фотография krvsa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
doublefintЕще ошибка, сорри :(
Код: 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 str,l,i s str="",l=$L(Str,Sub1)
 F i= 1 : 1 :l s $P(str,Sub2,i)=$P(Str,Sub1,i)
 Q str

Вот что показывает несложный тест...

Код: plaintext
1.
w $$TransDF^tmp( 112221133311444 , 11 )
 444 
...
Рейтинг: 0 / 0
$TRANSLATE
    #36763271
MX-9
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
krvsadoublefintЕще ошибка, сорри :(
Код: 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 str,l,i s str="",l=$L(Str,Sub1)
 F i= 1 : 1 :l s $P(str,Sub2,i)=$P(Str,Sub1,i)
 Q str

Вот что показывает несложный тест...

Код: plaintext
1.
w $$TransDF^tmp( 112221133311444 , 11 )
 444 


пипец !

НАМ ЭТА НИАСИЛИТЬ !!!
...
Рейтинг: 0 / 0
$TRANSLATE
    #36763280
Alexey Maslov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Что-то мне подсказывает, что для необратимых изменений нужна другая проверка корректности...
...
Рейтинг: 0 / 0
$TRANSLATE
    #36763318
MX-9
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Alexey MaslovЧто-то мне подсказывает, что для необратимых изменений нужна другая проверка корректности...

полный пипец !!

необратимые изменения моска !!

strrep(str,replace,with) public { ; (ISC, AM)
q:$g(str)=""||($g(replace)="") str
s with=$g(with),pos=0
loop Set pos=$find(str,replace,pos) QUIT:'pos str GOTO loop Set str=$extract(str,1,pos-$length(replace)-1)_with_$extract(str,pos,*),pos=pos+($length(with)-$length(replace)) Goto loop
}


w $$strrep(123,1,5)

выдал
123

УЖОС !!
...
Рейтинг: 0 / 0
$TRANSLATE
    #36763403
Фотография krvsa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
MX-9w $$strrep(123,1,5)

выдал
123

УЖОС !!
MX-9и вообще тестить вредно -
для тестующего
Видно это еще и заразно!
...
Рейтинг: 0 / 0
$TRANSLATE
    #36763477
MX-9
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
krvsa,

кстати поэтому
$$strrep работал быстрее всех :))
...
Рейтинг: 0 / 0
$TRANSLATE
    #36763731
Alexey Maslov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
MX-9w $$strrep(123,1,5)
выдал
123
Исправлено. Теперь умеет заменять и на "". Скоростное преимущество сохраняется для длинных строк ($l(str)>200). Есть хоть какой-то толк от этих упражнений? м.б. жару немного помогут пережить :)
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
strrep(str,replace,with) ; (ISC, AM)
 n pos,bTr,cc
 q:$g(str)="" str
 s replace=$g(replace),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
$TRANSLATE
    #36763760
Alexey Maslov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
На самом деле так (потерял проверку на пустую replace):
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
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
$TRANSLATE
    #36763943
MX-9
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Alexey Maslov,

толк есть - физзарядка !

жара у нас прекратилась - специально для Новой Волны
посмотрите обязательно в записи вчерашний концерт в Юрмале

Киркоров удивил - забойные штаны и клип !
...
Рейтинг: 0 / 0
$TRANSLATE
    #36764017
Фотография krvsa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
MX-9жара у нас прекратилась
У нас похоже самый пик - по прогнозам две недели будет за 40. На солнце в полдень шкалы термометра не хватает - зашкаливает за 50.
...
Рейтинг: 0 / 0
$TRANSLATE
    #36764089
doublefint
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
krvsa, опять спасибо!
...
Рейтинг: 0 / 0
$TRANSLATE
    #36764090
MX-9
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
krvsa,

в жару не кладите на сиденье авто
CD-диски в пласмассовых коробках

на солнце за время стоянки
пластик скукоживается в художественные фигуры

проверено лично
...
Рейтинг: 0 / 0
$TRANSLATE
    #36764107
Alexey Maslov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
krvsaУ нас похоже самый пик - по прогнозам две недели будет за 40.Вам положено - вы южане :)
...
Рейтинг: 0 / 0
$TRANSLATE
    #36764120
Фотография krvsa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
MX-9 , я руки об руль обжигаю. Пока кондёр его не охладит - ехать трудно.
...
Рейтинг: 0 / 0
25 сообщений из 82, страница 2 из 4
Форумы / Caché, Ensemble, DeepSee, MiniM, IRIS, GT.M [игнор отключен] [закрыт для гостей] / $TRANSLATE
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]