Если второй и третий аргументы определяют списки с взаимно однозначным соответствием их элементов, то сведение кратностей производится по всем элементам списка G с соответствующими им кратностями из списка N. При этом, если nops(G) > nops(N), то последние nops(G) - nops(N) элементов из G получают кратность 1 в возвращаемом результате. Если же G – список и N – положительное целое, то все элементы G получают одинаковую кратность N. Наконец, если G – символ либо строка и N – список, то G получает кратность N[1] в возвращаемом результате. Процедура Red_n является довольно полезным средством при работе со строками и символами, используется она и целым рядом средств нашей Библиотеки [41,103,109].
Вызов процедуры deltab(T, r, a) возвращает NULL-значение, т.е. ничего, обеспечивая удаление из таблицы T всех элементов, имеющих соответствие по отношению к выражению a, в зависимости от заданного режима удаления r, а именно: r=0 – равенство входов, r=1 – равенство выходов и r=2 – наличие любого из указанных равенств. Процедура – достаточно полезное средство в ряде приложений, имеющих дело с табличными структурами.
| deltab := proc(T::table, r::{0, 1, 2}, a::anything) local b c d k p n, , , , , ; assign(b = op 2,( eval(T)), d = op 1,( eval(T)), c = ((x y, ) → `if`(x y( ) = args 3 .. -1[ ], NULL y, ))); assign67(n = nops(b), p = args 3 .. -1[ ]), assign ' '( T = table(d, [seq `if`( (r = 0, c(lhs, b[k], p), `if`(r = 1, c(rhs, b[k], p), `if`(c(rhs, b k[ ], p) = NULL or c(lhs, b k[ ], p) = NULL NULL, , b k[ ]))), k = 1 .. n)])) end proc > T:= table([x=a, y=b, z=Art, Art=17, Kr=10]); T := table([z = Art, Art = 17, Kr = 10, x = a, y = b]) > deltab(T, 0, Art), eval(T); deltab(T, 1, a), eval(T); deltab(T, 2, Art), eval(T); table([z = Art, Kr = 10, x = a, y = b]) table([z = Art, Kr = 10, y = b]) table([Kr = 7, y = b]) |
В качестве замены для стандартной assign-процедуры для Maple 6-11 может вполне выступить процедура assign67. Своими возможностями процедура assign67 достаточно существенно расширяет процедуру assign, выполняя те назначения, на которых даже релиз 10 пакета вызывает ошибочные ситуации. Следующий фрагмент представляет исходный текст процедуры и некоторые примеры ее применения.
| assign67 := proc(X) local Art Kr k, , ; `Copyright (C) 2002 by the International Academy of Noosphere. All rights r \ eserved.`; Art Kr, := [ ] [ ], ; try for k to nargs do if type(args[ ]k , 'equation') then Kr := [op(Kr), k] else NULL end if end do; if nargs = 0 then NULL elif Kr = [ ] and type(X, {`::`, 'symbol', 'function', 'name'}) then X := args 2 .. -1[ ] elif nargs = 1 and type( ,X 'equation') and nops [( lhs(X)]) = nops [( rhs(X)]) then seq procname(( op(k, [lhs(X)]), op(k, [rhs(X)])), k = 1 .. nops([lhs(X)])) elif nargs = 1 and type(X, {'list', 'set'}) then seq(procname op( ,( k X)), k = 1 .. nops(X)) elif type(X `=`, ) and Kr = [1] or type(X, {'list', 'set'}) then procname(op(X), args 2 .. -1[ ]) elif Kr ≠ [ ] and type(X, {`::`, 'symbol', 'equation', 'function', 'name'}) then for k to Kr[1] − 1 do procname(args[k]) end do; for k to nops(Kr) − 1 do procname(args[Kr k[ ] .. Kr[k + 1] − 1]) end do; procname args[( Kr[-1] .. -1]) else procname '( Art' = [seq `if` type(( ( args[ ]k , 'name') or type(args[k], 'equation') and type(lhs(args[k]), 'name'), k, NULL), k = 1 .. nargs)]), `if`(Art = [ ], NULL, procname args[( Art[1] .. -1])) end if catch "wrong number (or type) of parameters": seq( procname args[( Kr k[ ]]), k = 1 .. nops(Kr)) end try ; NULL end proc > assign(x=64, y=59, 39, z=17, 10); # Maple 10 Error, (in assign) invalid arguments > assign67(x=64, y=59, 39, z=17, 10); x, [y], [z]; ⇒ 64, [59], [17, 10] > assign67(('q', 'w', 'e') = (42, 47)); [q], [w], [e]; ⇒ [w, e, 42, 47], [w], [e] > assign67(1,2,3); assign67(); assign(NULL); assign(Z), Z, assign67(Art_Kr=NULL), [Art_Kr]; [] > assign67(('q', 'w', 'e') = (1, 2, 3)); assign67(('x', 'y', 'z') = (64, 59, 39)), [x, y ,z], [q], [w], [e]; [64, 59, 39], [1], [2], [3] > assign67(V=42,64,G=47,59,S=67,39,Art=89,17,Kr=96,9,Ar=62,44),[V],[G],[S],[Art],[Kr],[Ar]; [42, 64], [47, 59], [67, 39], [89, 17], [96, 9], [62, 44] |
Процедура assign67, расширяя возможности стандартной assign-процедуры релизов 6 – 10, оперспечивает дополнительно такие операции как множественные присвоения последовательностей значений переменным, множественные присвоения NULL-значений и др. При этом, вызов процедуры assign67 корректен на любом кортеже фактических аргументов, обеспечивая достаточно широкий диапазон типов и вариантов присвоений наряду с непрерывностью вычислений. Лучше всего возможности процедуры assign67 иллюстрируются наиболее типичными примерами ее применения [41,103,109]. Например, вызов процедуры assign67(x1, x2, x3,…), если фактическими аргументами являются символы, делает присвоение x1:= x2, x3, … . Тогда как вызов assign67(x1, x2,…,xk, y=a,…) при том же предположении производит присвоения x1:=NULL,…, xk:=NULL. Уже в настоящей реализации процедура assign67 во многих случаях упрощает программирование в среде Maple-языка, однако она допускает и дальнейшие интересные расширения.
Вызов процедуры type(P, fpath) возвращает true-значение, если аргумент Р определяет допустимый полный путь, и false-значение в противном случае. При этом, следует иметь в виду, что возврат true-значения лишь говорит, что проверяемый каталог Р, вообще говоря, может быть элеменьтом файловой системы компьютера.
| type/fpath := proc(P::{string, symbol }) local a b f f1 k p w z dir df, , , , , , , , , ; assign(a = CF2(P), w = interface(warnlevel), z = (x → null interface(( warnlevel = x)))), z(0); `if`(Red_n(a, " " 1, ) = "" or length(a) < 3 or a[2 .. 3] ≠ ":\", [z(w), RETURN(false)], assign(p = 97 .. 122)); z w( ), `if` member(( convert(a[1], 'bytes'), {[ ]k $ (k = p)}), `if`( member(a[1], map(CF2, {Adrive( )})), NULL, WARNING "<%1> is idle disk drive",( Case(a[1], 'upper'))), ERROR "<%1> - illegal logical drive name",( Case(a[1], 'upper'))); assign(f = cat(WT( ), "\_$$$14_06_2005$$$" ), b = currentdir( )); f1 := cat ,(f a[3 .. -1]); df := proc( )x for k to nops( )x do try rmdir(x k[ ]) catch : next end try end do end proc ; try MkDir(f1) catch : dir := [op InvL(( DirF( ))f ), ]f ; df dir( ); currentdir(b); RETURN(false) end try ; dir := [op InvL(( DirF( ))f ), ]f ; df dir( ); true end proc > type("G:/aaa\bbb/ccc\ddd/salcombe.txt", 'fpath'); ⇒ true Warning, <G> is idle disk drive > type("@:/aaa/bbb/ccc/ddvb/hhh", 'fpath'); Error, (in type/fpath) <@> - illegal logical drive name > type("C:/*aaa/bbb/cc*c/ddvb/hhh", 'fpath'); ⇒ false > type("C:/aaa\bbb/ccc\ddd/salcombe.txt", 'fpath'); ⇒ true > type("C:/aaa\bbb/ccc\ddd/salcombe.txt", 'path'); ⇒ false |
Данная процедура хорошо дополняет процедуру `type/path` [41,103] и представляется довольно полезной в ряде задач, имеющих дело с обработкой файлов данных.
В ряле случаев возникает необходимость программной проверки имени текущего документа. Нижеследующая процедура mwsname успешно решает данную задачу.
| mwsname := proc() local a b c t k, , , , ; unassign '( VGS_vanaduspension_14062005 '); VGS_vanaduspension_14062005 ; assign(' 'c = "$Art16_Kr9$", ' 't = interface(warnlevel)), assign('a' = system(cat("tlist.exe > ", c))); if a ≠ 0 then try null interface(( warnlevel = 0)), com_exe2({`tlist.exe`}) catch "programs appropriate": null interface(( warnlevel = t)), RETURN(delf( )c , false) end try ; null interface(( warnlevel = t)), goto(VGS_vanaduspension_14062005 ) end if; assign(b = fopen(c, 'READ')); while not Fend( )c do a := readline(c); if search(a, " Maple ") then k := Search2(a, {"]" "[", }); delf( )c , assign(' 'a = a[k[1] .. k[-1]]); if search(a, "[Untitled" ' ', c ) then RETURN(cat(``, a[c + 1 .. Search(a, ")")[1]])) else c := Search(a, ".mws" ;) b := Search(a, "[" ;) RETURN cat( , ( `` a[b[1] + 1 .. c[1] + 3])) end if end if end do end proc > mwsname(); ⇒ ProcLib_6_7_8_9.mws |
Успешный вызов процедуры mwsname() возвращает имя текущего документа в symbolформате. При этом предполагается, что в текущем Windows-сеансе инициирован только один Maple-сеанс. Процедура mwsname достаточно полезна при программной обработке текущих Maple-документов.
Для целого ряда задач весьма полезным оказывается вызов процедуры type(P, boolproc).
| type/boolproc := proc(P::anything) local _Art16_Kr9_ _avz63_, , ω ν, , ;z option `Copyright International Academy of Noosphere - Tallinn, November, 2003` , remember; `if` type(( eval(P), 'procedure'), assign(`type/_avz63_` = eval(P)), RETURN(false)); assign(ω = (x → interface(warnlevel = x)), z = (( ) → unassign('`type/_avz63_`'))); try ν := interface(warnlevel); |
| ω(0); type(_Art16_Kr9_, '_avz63_'); true, null(ω ν( )), z( ) catch "result from type `%1` must be true or false": RETURN(false, null(ω ν( )), z( )) catch "%1 is not a procedure": RETURN(false, null(ω(ν)), z( )) catch "%1 uses " RETURN(: false, null(ω ν( )), z( )) catch "invalid input: %1 expects" RETURN(: false, null(ω ν( )), z( )) catch "quantity of actual arguments" RETURN(: false, null(ω ν( )), z( )) catch : RETURN (true, null(ω ν( )), z( )) end try end proc > map(type, [IsOpen, `type/file`, PP, isDir, IsFempty, MkDir, lexorder, Empty, mwsname, `type/boolproc`, `type/package`, `type/dir`, save2], 'boolproc'); [true, true, false, true, true, false, true, true, false, true, true, true, false] |
Вызов процедуры type(P, boolproc) возвращает true-значение, если Р является булевской процедурой (т.е. возвращает только значения true или false), и false-значение в противном случае. Процедура производит тестирование с высокой степенью достоверности. В случае необходимости процедура type(P, boolproc) легко адаптируется на особые типы тестируемых процедур посредством подключения дополнительных catch-блоков.