Ստրուկտուրաներ TCL լեզվի համար

Կուրսային աշխատանքի նախագիծ։

Այս գրառման մեջ ես ուզում եմ TCL լեզվի օրինակով ցույց տալ, թե ինչպես կարելի է ընդլայնել ծրագրավորվող ծրագրավորման լեզուն, և այն ընդլայնումն էլ ուզում եմ ցույց տալ ստրուկտուրաների օրինակով։ Գաղափարները ես փոխառել եմ Common Lisp լեզվից։

Գիտեմ (իհարկե, որոշ վերապահումներով), որ TCL լեզվում բացակայում են ստրուկտուրաների (գրառումների) հետ աշխատելու գործիքները, և TLC լեզվում առկա են ցուցակ և տող տիպերը և դրանց հետ աշխատելու ֆունկցիաները։ Ես պետք է «ստրուկտուրա» (struct, record) և «նմուշ» (instance) գաղափարներն արտապատկերեմ «ցուցակ» (list), միգուցե նաև «տող» (string) գաղափարներին։

Եթե, օրինակ, արդեն սահմանել եմ person (անձ) ստրուկտուրան, ապա 42 տարեկան Վչոյին նկարագրող նմուշը կարող է ունենալ հետևյալ տեսքը։

{person name Վչո age 42}

Այստեղ երևում է, որ person ստրուկտուրայի նմուշը ներկայացված է մի ցուցակով, որի առաջին տարրը ստրուկտուրայի անունն է, իսկ հաջորդ տարրերը կազմում են սլոտ֊արժեք զույգերի հաջորդականություն։ Նմուշի այսպիսի ներկայացման դեպքում, կարծում եմ, արդեն դժվար չէ սահմանել այն գործիքները, որոնցով աշխատելու եմ ստրուկտուրաների ու դրանց նմուշների հետ։

Քանի որ TCL լեզվում ծրագրի կառուցման բլոկը (շինանյութը) պրոցեդուրան է, ապա ստրուկտուրաների և դրանց նմուշների հետ աշխատելու համար պետք է ունենալ ա) ստրուկտուրա սահմանող, բ) ստրուկտուրայի նմուշ ստեղծող, գ) ստրուկտուրայի դաշտերի (սլոտների) արժեքներ կարդացող և փոփոխող պրոցեդուրաներ։

Օգտագործելով person ստրուկտուրայի օրինակը, սկսեմ սահմանել այդ թվարկված պրոցեդուրաները։ Բայց, առաջ անցնելով ենթադրեմ, թե արդեն սահմանված է struct պրոցեդուրան, որը կատարման միջավայրում սահմանում է նոր ստրուկտուրա։ Դրա օգնությամբ սահմանեմ person ստրուկտուրան։

struct person { name gender age }

Թող create_person պրոցեդուրան վերադարձնում է person ստրուկտուրայի չարժեքավորված նմուշ (կոնստրուկտոր պրոցեդուրա է)։

proc create_person {} {
    list person name {} age {}
}

Վարժություն 1։ Սահմանել create_person պրոցեդուրայի մի այլ տարբերակ, որն արգումենտում ստանում է սլոտների սկզբնական արժեքները և ստեղծում է person ստրուկտուրայի արժեքավորված նմուշ։

Այնուհետև, թող person_name պրոցեդուրան արգումենտում ստանում է person նմուշը և վերադարձնում է դրա name սլոտի արժեքը։

proc person_name { inst } {
    set ps [lsearch $inst name]
    lindex $inst [expr {$ps + 1}]
}

person_name֊ին ստիմետրիկ սահմանեմ նաև person_name_set պրոցեդուրան, որը նմուշի name սլոտին վերագրում է նոր արժեք։

proc person_name_set { inst val } {
 upvar $inst obj
 set ps [lsearch $obj name]
 lset obj [expr {$ps + 1}] $val
}

Վարժություն 2։ Ձևափոխել person_name և person_name_set պրոցեդուրաներն այնպես, որ այն ստուգի, թե արդյո՞ք inst֊ը person-ի նմուշ է։

Վարժություն 3։ Սահմանել նաև age սլոտի արժեքը գրող և կարդացող պրոցեդուրաները։

Հիմա վերադառնամ բուն ստրուկտուրան սահմանող struct պրոցեդուրային։ Արդեն պարզ է, որ s0, s1,... sk սլոտներն ունեցող S ստրուկտուրան սահմանել, նշանակում է կատարման միջավայր ներմուծել create_S կոնստրուկտորը, իսկ ամեն մի si սլոտի համար՝ S_si և S_si_set անունով պրոցեդուրաները։ Այլ կերպ ասած, ստրուկտուրաներ սահմանող struct պրոցեդուրան ամեն մի նոր ստրուկտուրայի համար պետք է սահմանի դրա կոնստրուկտոր և սլոտներին դիմող պրոցեեդուրաները, ինչպես նաև նմուշի տիպը հաստատող պրեդիկատ պրոցեդուրան։ Ահա այն․

proc struct { name slots } {
 set slpatt [list $name]
 foreach sl $slots {
  uplevel "proc ${name}_${sl} \{ inst \} \{
          set ps \[lsearch \$inst $sl]
          lindex \$inst \[expr \{\$ps + 1\}\] \}"

  uplevel "proc ${name}_${sl}_set \{ inst val \} \{
          upvar \$inst obj
          set ps \[lsearch \$obj $sl\]
          lset obj \[expr \{\$ps + 1\}\] \$val \}"

  lappend slpatt $sl {}
 }

 uplevel "proc create_$name \{\} \{ list $slpatt \}"

 uplevel "proc is_$name \{ inst \} \{
      string equal $name \[lindex \$inst 0 0\] \}"
}

Չնայած նրա մի քիչ խճճված տեսքին, տրամաբանությունը բավականին պարզ է։ Այն սահմանում է վերը պահանջված պրոցեդուրաները։

Վարժություն 4։ Ստրուկտուրաների սահմանման, դրանց նմուշների ու սլոտների հետ աշխատող պրոցեդուրաները լրացնել (ընդլայնել) սխալների ստուգման մեխանիզմով։

Ծրագրավորման լեզուն ընդլայնելու մասին

Վերջերս ես հանդիպեցի թե ինչպես են C++ լեզվում ներմուծել հայերեն ծառայողական բառեր։ Դա արվել էր, բնականաբար, նախապրոցեսորի (preprocessor) օգնությամբ։ Պարզապես ամեն մի բառի համար սահմանվել էր նրա համարժեք հայերեն տարբերակը, որն էլ նախամշակման ժամանակ փոխարինվում էր լեզվի իսկական ծառայողական բառով։ Դա ուներ մոտավորապես ուներ այսպիսի տեսք․

#define եթե if 
#define այլապես else 
#define մինչ while 
#define վերադարձնել return 
#define ամբողջ int

Եվ այս սահմանումներով, օրինակ, էվկլիդեսի ալգորիթմը կարելի է գրառել հետևյալ տեսքով․

ամբողջ euclid( ամբողջ n, ամբողջ m ) {
    մինչ( n != m ) {
        եթե( n > m )
            n %= m;
        այլապես
            m %= n;
    }
    վերադարձնել n + m;
}

Երբ հայերեն ծառայողական բառերի սահմանումներն ու դրանց օգտագործմամբ գրված ծրագիրը գրենք *.cpp ֆայլում, և clang++ կոմպիլյատորի նախապրոցեսորին խնդրենք մշակել այդ ֆայլը․

$ clang -E ex0.cpp

Ապա կստանանք «մաքուր» C++ լեզվով գրված կոդ։

int euclid( int n, int m ) {
    while( n != m ) {
        if( n > m )
            n %= m;
         else
            m %= n;
    }
    return n + m;
}

Պարզ է, որ եթե ուզում ենք ծրագրավորել հայերեն բառերով, ապա C++ լեզուն ավելի լավ տարբերակ չի առաջարկում․ կոմպիլյացիայից առաջ ծրագրի տեքստում փոփոխություններ կատարելու միակ հնարավոր եղանակը նախապրոցեսորի օգտագործումն է։ Պարզ է նաև, որ չենք կարող լեզվում նոր ղեկավարող կառուցվածքներ ավելացնել։ Օրինակ, ինչպե՞ս ավելացնել repeat տիպի կրկնման գործողություն։

repeat( 10 ) {
    std::cout << "Ողջո՜ւյն։\n";
}

* * *

Լրիվ այլ պատկեր է այն լեզուներում, որոնց ընդունված է ասել «ծրագրավորվող ծրագրավորման լեզուներ»։ Այդ դասի վառ ներկայացուցիչներ են Lisp ընտանիքի լեզուները՝ մակրոսների սահմանման իրենց հնարավորություններով։ «Ծրագրավորվող» լինելու հատկությամբ է օժտված նաև Tcl լեզուն, որում վերը բերված repeat կառուցվածքը սահմանելը ամենևին էլ բարդ բան չէ։ Ահա այն․

proc repeat { num body } {
    set result {}
    while { $num != 0 } {
        incr num -1
        set result [uplevel $body]
    }
    return $result
}

Նույնիսկ սրա հայերեն տարբերակի սահմանումն է բավականին հետաքրքիր։

proc կրկնել { count անգամ body } {
    if { ${անգամ} ne {անգամ} } then {
        error "Syntax error."
    }
 
    set result {}
    while { $count != 0 } {
        incr count -1
        set result [uplevel $body]
    }
    return $result
}

Այստեղ սահմանված է կրկնել անունով պրոցեդուրան, որը ունի երեք պարամետր։ Պարամետրերից առաջինը կրկնությունների քանակն է, երկրորդը կատարում է անգամ ծառայողական բառի դերը, իսկ երրորդը կրկնման հրամանի մարմինն է։ կրկնել պրոցեդուրայի մարմնում նախ ստուգում եմ, որ երկրորդ պարամետրի արժեքն անպայման լինի անգամ տողը։ Ահա նաև կիրառությունը․

կրկնել 5 անգամ {
    puts Hello!
}

Բայց ինչպե՞ս է սա աշխատում։ Չէ՞ որ Tcl լեզվի proc հրամանը պարզապես սահմանում է նոր ֆունկցիա, և, բոլորս էլ լավ գիտենք, որ ֆունկցիայի կանչի ժամանակ արգումենտները հաշվարկվում են ֆունկցիային փոխանցելուց առաջ։ Եվ, տվյալ դեպքում, «{ puts {Ողջո՜ւյն։} }» արգումենտի արժեքը պետք է հաշվարկվեր և պետք է մի անգամ արտածվեր «Ողջո՜ւյն։» տեքստը։

Բացատրությունը Tcl լեզվի միակ տիպի՝ տողի հաշվարկման կանոնների մեջ է։ Եթե տողը պարփակված է { և } ձևավոր փակագծերում, ապա այն փոխանցվում է այնպես, ինչպես կա (as-is), ոչ մի հաշվարկ չի կատարվում, ոչ մի ձևափոխություն չի կատարվում։ { և } փակագծերը տողը «պաշտպանում» են հաշվարկումից։ Եվ այդ պաշտպանությունը հնարավորություն է տալիս տողը դիտարկել որպես «ղեկավարող կառուցվածքի» բլոկ։

Օգտագործելով Tcl լեզվում պրոցեդուրաներ սահմանելու proc հրամանը և կոդի բլոկը ստեկի մեկ այլ կադրում հաշվարկելու uplevel հրամանը, կարելի է լեզուն ընդլայնել (համալրել) հայերեն ծառայողական բառեր ունեցող ղեկավարող կառուցվածքներով։ Եվ քանի որ նոր կառուցվածքները սահմանվելու են որպես պրոցեդուրաներ, ապա դա հնարավորություն է տալիս կատարել շարահյուսական և իմաստաբանական ստուգումներ։ Դրա օրինակ է վերը սահմանված կրկնել պրոցեդուրայում անգամ բառի առկայության ստուգումը։

* * *

Լեզուն ընդլայնելու (ասում են նաև՝ լեզվի մեջ նոր լեզու սահմանելու) էլ ավելի լայն ու հետաքրքիր հնարավորություններ են ընձեռնում Lisp ընտանիքի Common Lisp և Scheme լեզուները։ Բայց, ինչպես ասում էր Ֆ․ Դոստոևսկին, դա արդեն ուրիշ պատմության նյութ է։

Tcl պրոցեդուրաները

Tcl լեզվում պրոցեդուրները (կամ ֆունկցիաները) սահմանվում են proc հրամանի միջոցով։ Այն ստանում է երեք արգումենտ. ա) սահմանվող պրոցեդուրայի անունը, բ) արգումենտների ցուցակը, և գ) մարմինը։ Օրինակ, տրված x և y թվերից մեծը որոշող ֆունկցիան կարելի է սահմանել հետևյալ կերպ.

proc max { x y } {
    if { $x > $y } then {
        return $x
    }
    return $y
}

Կամ, եթե չենք ուզում օգտագործել if հրամանը.

proc max { x y } {
    return [expr {$x > $y ? $x : $y}]
}

Այս երկու օրինակներում էլ return հրամանն օգտագործված է ֆունկցիայի մարմնից արժեք վերադարձնելու համար։ Tcl պրոցեդուրաները կառուցված են այնպես, որ եթե նրա մարմնում, կամ կատարման որևէ ճյուղում, որը բերում է պրոցեդուրայի ավարտի, բացակայում է return հրամանը, ապա ֆունկցիայի վերադարձրած արժեք է համարվում դրա կատարման ժամանակ վերջին արտահայտության հաշվարկված արժեքը։ Սա հաշվի առնելով, կարող են նախորդ օրինակը գրել առանց return հրամանի.

proc max { x y } {
    expr {$x > $y ? $x : $y}
}

Եթե պրոցեդուրան սպասում է միայն մեկ արգումենտ, ապա սահմանման ժամանակ այդ միակ ֆորմալ արգումենտի անունը կարելի է գրել առանց ձևավոր փակագծերի։ Օրինակ, Սահմանենք մի պրոցեդուրա, որը ստուգում է տրված բառի պալինդրոմ լինելը.

proc palindrom? str {
    string equal $str [string reverse $str]
}

Իսկ եթե արգումենտների ցուցակում վերջին կամ միակ արգումենտի անունը args է, ապա նրա միջոցով, որպես ցուցակ, պրոցեդուրայի մարմնին են փոխանցվում կամայական թվով արժեքներ։ Օրինակ, ահմանենք մի ֆունկցիա, որը հաշվում է երկու և ավելի թվերի թվաբանական միջինը.

proc average { a b args } {
    set sum [expr {$a + $b}]
    foreach n $args {
        set sum [expr {$sum + $n}]
    }
    return [expr {$sum / (2 + [llength $args])}]
}

Ահա նաև այս պրոցեդուրայի օգտագործման մի քանի օրիակ.

average 1.1 2.2                    ; # => 1.6500000000000001
average 1.1 2.2 5.5 4.4 3.3        ; # => 3.3
average 1.2 2.3 3.4                ; # => 2.3000000000000003

proc հրամանը հնարավորություն է տալիս սահմանել նաև լռելությոն (default) արժեքով արգումենտներ ունեցող պրոցեդուրաներ։ Այդ դեպքում արգումենտը տրվում է երկու տարրերի ցուցակի տեսքով, որոնցից առաջինը ֆորմալ արգումենտի անունն է, իսկերկրորդը՝ նրա լռելության արժեքը։ Օրինակ, սահմանենք մի ֆունկցիա, որը վերադարձնում է \(y\) թվի \(n\) աստիճանի արմատը՝ \(\sqrt[n]{y}\), եթե \(n\)-ը տրված չէ, այն համարվում է \(2\)։

proc root { y {n 2} } {
    expr exp(log($y) / $n)
}

Ահա կիրառման օրինակներ.

root 1024           ; # => 32.0
root 1024 5         ; # => 4.0
root 1024 10        ; # => 2.0

Tcl: Թվերի արտահայտումը բառերով

Այս գրառման մեջ Tcl լեզվով իրականացված է 1-ից 999999 միջակայքի բնական թվերի բառային արտահայտման ալգորիթմը։ (Ամբողջական ֆայլը։)

#
# միավորների անունները հայերեն
#
set ONES {"" մեկ երկու երեք չորս հինգ վեց յոթ ութ ինը}

#
# տասնավորների անունները հայերեն
#
set TENS {"" տաս քսան երեսուն քառասուն հիսուն վաթսուն յոթանասուն ութսուն իննսուն}

#
# n-ը պատկանում է [a; b] միջակայքին
#
proc is_in { n a b } { 
  return [expr {($n >= $a) && ($n <= $b)}]
}

#
# վերադարձնում է երկու տարրերի ցուցակ, որոնցից առաջինը
# (ds / dr) քանորդն է, իսկ երկրորդը՝ (ds % dr) մնացորդը
#
proc divr { ds dr } {
  return [list [expr {$ds / $dr}] [expr {$ds % $dr}]]
}

#
# Հիմնական ձևափոխություն
#
proc number_to_words num {
  # եթե թիվը 0-9 միջակայքում է, ...
  if [is_in $num 0 9] {
    # ... ապա վերադարձնել միավորների ցուցակի համապատասխան տարրը
    return [lindex $::ONES $num]
  }

  # եթե թիվը 10-99 միջակայքում է, ...
  if [is_in $num 10 99] {
    # ... ապա առանձնացնել տասնավորի ու միավորի նիշը, ...
    lassign [divr $num 10] a b
    # ... ՛տաս՛-ով սկսվող բառերի համար տասնավորի ու միավորի 
    # միջև պետք է գրել ՛ն՛ տառը, օրինակ, ՛տասներկու՛, ...
    set s [expr {$a == 1 && $b != 0 ? {ն} : {}}]
    # ... վերադարձնել տասնավորների ու միավորների համապատասխան 
    # տարրերից կազմված արտահայտությունը
    return "[lindex $::TENS $a]${s}[lindex $::ONES $b]"
  }

  # եթե թիվը 100-999 միջակայքում է, ...
  if [is_in $num 100 999] {
    # ... ապա առանձնացնել հարյուրավորի նիշը և 100-ի բաժանելու մնացորդը, ...
    lassign [divr $num 100] a b
    # ... միավորների ցուցակից վերցնել հարյուրավորի նիշին համապատախան բառը,
    # նրան կցել ՛հարյուր՛ բառը, իսկ 100-ի բաժանելու մնացորդի վրա նորից կիրառել
    # number_to_words ֆունկցիան
    return "[lindex $::ONES $a] հարյուր [number_to_words $b]"
  }

  # եթե թիվը 1000-999999 միջակայքում է, ...
  if [is_in $num 1000 999999] {
    # ... ապա այն տրոհել երկու կտորի՝ 1000-ին բաժանելու քանորդ և մնացորդ, ...
    lassign [divr $num 1000] a b
    # ... ստացված կտորները ձևափոխել number_to_words ֆունկցիայով, 
    # և իրար կցել՝ արանքում դնելով ՛հազար՛ բառը
    return "[number_to_words $a] հազար [number_to_words $b]"
  }  

  return ""
}

Տեստավորման փորձ։

#
# գեներացնել [0;N) միջակայքի պատահական ամբողջ թիվ
#
proc random N {
  return [expr {int(rand() * $N)}]
}

#
# number_to_words ֆունկցիան փորձարկել 10 պատահական թվերով
#
for {set i 0} {$i < 10} {incr i} {
  set k [random 1000000]
  set v [number_to_words $k]
  puts "$k -- $v"
}

Ֆայլեր։ Pixmap պատկերի խոշորացում

Ենթադրենք տրված է pixmap պատկեր պարունակող պարզեցված ֆայլ և պահանջվում է գրել մի ծրագիր, որը պատկերը կխոշորացնի տրված գործակցով։ Օրինակ, ստորև բերված են հայերեն "Բ" տառի սկզբնական pixmap պատկերը և նրա երկու անգամ խոշորտացված տարբերակը։

...... ..##.. .#..#. .#..#. .#.... .####. .#.... .#.... .#.... ......

............ ............ ....####.... ....####.... ..##....##.. ..##....##.. ..##....##.. ..##....##.. ..##........ ..##........ ..########.. ..########.. ..##........ ..##........ ..##........ ..##........ ..##........ ..##........ ............ ............

Ծրագիրը պետք կարդա ձախ կողմի պատկերը պարունակող ֆայլը և ստեղծի նոր ֆայլ՝ աջ պատկերի պարունակմամբ։

Թող ամբողջ աշխատանքը կատարող պրոցեդուրան կոչվի enlarge, որը ստանում է երկու արգումենտ. պատկերը պարունակող ֆայլի անունը՝ pixmap և խոշորացման գործակիցը՝ sc։

proc enlarge { pixmap {sc 2} } {

Հետո պետք է բացել ֆայլը, նրա պարունակությունը կարդալ որևէ փոփոխականի մեջ, ապա նորից փակել ֆայլը։ Tcl լեզվում ֆայը բացվում է open պրոցեդուրայով, որի առաջին արգումենտը ֆալի անունն է, իսկ երկրորդով որոշվում է, թե ինչ գործողություն է կատարվելու ֆայլի հետ՝ գրել (w), կարդալ (r) և այլն։ open պրոցեդուրան վերադարձնում է ֆայլային հոսք, որից կարելի է կարդալ, կամ նրա մեջ կարելի է գրել։

  set inp [open $pixmap r]

Ֆայլի պարունակությունը ամբողջությամբ կարդում է read պրոցեդուրան։ Այն ստանում է կարդալու համար բացված ֆայլային հոսք և վերադարձնում է հոսքի ամբողջ պարունակությունը։

  set img [read $inp]

Դե, իսկ close պրոցեդուրան փակում է բացված ֆայլային հոսքը։

  close $inp

Պատկերը \(n\) անգամ խոշորացնելու համար պետք է նրա ամեն մի կետը հորիզոնական և ուղղահայաց ուղղություններով ընդարձակել \(n\) անգամ։ Դրա համար պետք է վերցնել սկզբնական պատկերի ամեն մի տողը և, \(n\) անգամ կրկնելով նրա ամեն մի սիմվոլը, ստանալ նոր տող։ ՈՒղղահայաց ընդարձակման համար պետք է \(n\) անգամ կրկնել կառուցված տողը։

Արդյունքը կուտակելու համար նախատեսենք result փոփոխականը որպես դատարկ ցուցակ։

  set result [list]

Քանի որ տրված ֆայլի ամբողջ պարունակությունը կարդացվել էր img փոփոխականի մեջ, պետք է այն split պրոցեդուրայով տրոհել տողերի ու իտերացիա կազմակերպել տողերով։ split պրոցեդուրայի երկրորդ արգումենտով տրվում է այն բաժանիչը, ըստ որի պետք է տողը տրոհել ցուցակի։

  foreach line [split $img \n] {

Տողի սիմվոլներով իտերացիայի համար այն կարող ենք սիմվոլների ցուցակի վերածել split պրոցեդուրայով և ցուցակով անցնել foreach պրոցեդուրայով։ Հերթական սիմվոլը դիտարկելիս string repeat հրամանով այն պետք է բազմապատկել պահանջված քանակով ու կցել կառուցվող տողին՝ str փոփոխականին: Իսկ բոլոր սիմվոլներով անցնելուց հետո կառուցված տողին կցենք նոր տողի սիմվոլը։

    set str {}
    foreach char [split $line {}] {
      append str [string repeat $char $sc]
    }
    append str \n

Կառուցված տողը բազմապատկելու համար նորից օգտագործենք string repeat հրաման հրամանը և result ցուցակին կցենք lappend պրոցեդուրայով։

    lappend result [string repeat $str $sc]
  }

Այս դրությամբ արդեն result փոփոխականը պարունակում է նախնական պատկերի խոշորացված տարբերակը։ open հրամանով բացենք ֆայլ գրելու համար։

  set out [open sc$sc$pixmap w]

Այդ ֆայլի մեջ արտածենք կառուցված տողերի ցուցակը՝ դրանք նախապես իրար կցելով join պրոցեդուրայով։

  puts $out [join $result {}]

ՈՒ փակենք ֆայլը։

  close $out
}

Վերջ։ Հիմա կարող ենք կանչել enlarge պրոցեդուրան՝ նրան տալով pixmap ֆայլը և խոշորացման գործակիցը։

---

Ամբողջական պրոցեդուրան։

proc enlarge { pixmap {sc 2} } {
  set inp [open $pixmap r]
  set img [read $inp]
  close $inp

  set result [list]
  foreach line [split $img \n] {
    set str {}
    foreach char [split $line {}] {
      append str [string repeat $char $sc]
    }
    append str \n
    lappend result [string repeat $str $sc]
  }

  set out [open sc$sc$pixmap w]
  puts $out [join $result {}]
  close $out
}

Կոնֆիգուրացիոն ֆայլերի գեներացիա

Խնդիրը

Տրված է պարամետրերի ցուցակ և ամեն մի պարամետրի համար տրված է նրա արժեքների բազմությունը։ Այդ արժեքները կարող են լինել իդենտիֆիկատորներ, տողեր, իրական կամ ամբողջ թվեր, բայց որևէ պարամետր կարող է ունենալ միայն մեկ տիպի արժեքներ։ Այլ կերպ ասած՝ պարամետրի տիպը ֆիքսվում է։ Օրինակ, կարող են տրված լինել հետևյալ պարամետրերը․

A = {a, b, c}
B = {"s1", "u2", "v3", "z4"}
C = {1.2, 3.4}

Պետք է գեներացնել կոնֆիգուրացիոն ֆայլեր, որոնցից ամեն մեկը պարունակի տրված պարամետրերի մեկական արժեք։ Օրինակ, հետևյալները կարող են լինել այդպիսի ֆայլերի օրինակներ․

file1.cfg       file2.cfg       file3.cfg

A = a           A = c           A = c
B = "s1"        B = "z4"        B = "z4"
C = 1.2         C = 1.2         C = 3.4

Պահանջվում է կա՛մ գեներացնել ֆայլերի բոլոր հնարավոր տարբերակները, կա՛մ գեներացնել տրված քանակով և չկրկնվող պարունակությամբ ֆայլեր։

Պարզ է, որ խնդրի էությունը տրված պարամետրերի արժեքների բազմությունների դեկարտյան արտադրյալի հաշվարկն է։ Բայց ինչպե՞ս դա անել, երբ նախապես ոչինչ հայտնի չէ․ ո՛չ պարամետրերի քանակը, ո՛չ ամենի մի պարամետրի թույլատրելի արժեքների քանակը։ Այս հարցերին պատասխանելուց առաջ տամ մի քանի սահմանումներ։

Սահմանումներ

Դիցուք տրված է \(M=\left\langle S_n\right\rangle\) բազմությունների խումբը։ Այդ բազմությունների դեկարտյան արտադրյալ է կոչվում բոլոր \((x_1,x_2,\ldots,x_n)\) կարգավորված հավաքածուների բազմությունն է, որտեղ \(x_i\in S_i\)․

\[D=\prod_{k = 1}^n S_k = \left\{{\left({x_1, x_2, \ldots, x_n}\right): \forall k \in \mathbb{N}^*_n: x_k \in S_k}\right\}\]

Հեշտ է նկատել, որ դեկարտյան արտադրյալի բազմության տարրերի քանակը հավասար է արտադրիչ բազմությունների տարրերի քանակների արտադրյալներին։

\[|D|=\prod_{k=1}^n |S_k|\]

Թող արտադրյալ բազմության ամեն մի կարգավորված \((x_1,x_2,\ldots,x_n)\) n-յակի ինդեքս կոչվի այն \((r_1,r_2,\ldots,r_n)\) կարգավորված n-յակը, որի \(r_k\) տարրը ցույց է տալիս, որ \(x_k\) տարրը \(k\)-րդ բազմության \(r\)-րդ տարրն է։

Բոլոր հնարավոր տարբերակները

Tcl լեզվի ցուցակի տեսքով սահմանեմ արտադրիչ բազմությունների ցուցակը․

set params {{A {ayb ben gim}} {B {alpha beta gamma delta}} {C {1 2}}}

Այս ցուցակի ամեն մի տարրը նորից ցուցակ է և բաղկացած է երկու բազմության անունից ու արժեքների բազմությունից։ Այս արժեքների բազմությունն էլ իր հերթին տրված է ցուցակի տեսքով։

Այնուհետև հաշվեմ մի ցուցակ, որը պարունակում է արտադրիչ բազմությունների երկարությունները։ Նաև միաժամանակ հաշվեմ այդ ցուցակի տարրերի արտադրյալը։

set powers [list]
foreach e $params { lappend powers [llength [lindex $e 1]] }
set allelems [expr [join $powers { * }]]

Բոլոր հնարավոր տարբերակները գեներացնելու եմ վերը սահմանված հաջորդական ինդեքսների կառուցումով։ Եվ դրա համար index փոփոխականին վերագրում եմ զրոյական ինդեքսը։

set index [list]
for {set i 0} {$i < [llength $powers]} {incr i} { lappend index 0 }

Կազմակերպում եմ մի պարամետրով ցիկլ՝ արտադրյալ բազմության տարրերի քանակով, որի պարամետրը մասնակցելու է գեներացվող ֆայլի անունի մեջ։

for {set k 0} {$k < $allelems} {incr k} {

Այս պահին, երբ ունեմ զրոյական ինդեքսը, կարող եմ գեներացնել այդ ինդեքսին համապատասխան ֆայլը։ Դրա համար պետք է զուգահեռաբար անցնել ինդեքսի տարրերով ու արտադրիչ ցուցակներով, և ամեն մի ցուցակից ընտրել ու ֆայլում արտածել ինդեքսին համապատասխան տարրը։

  # generate one case
  set out [open case_${k}.cfg w] 
  foreach i $inx s $params {
    puts $out "[lindex $s 0] = [lindex [lindex $s 1] $i]"
  }
  close $out

Հիմա պետք է հաշվել հաջորդ ինդեքսը։ Դրա համար ընթացիկ ինդեքսին «գումարում» եմ մեկ։ Այս գործողությունը շատ նման է դիրքային գումարման գործողությանը, բայց կատարվում է ձախից աջ։

  #  calculate next index
  set res [list]
  set m 1
  foreach i $inx p $powers {
    set t [expr $i + $m]
    lappend res [expr {$t == $p ? 0 : $t}]
    set m [expr {$t == $p ? 1 : 0}]
  }
  set inx $res
}

Ահա և վերջ։ Այսքանով կարողանում եմ գեներացնել տրված բազմությունների դեկարտյան արտադրյալը, որի ամեն մի տարրը ձևավորվում ու արտածվում է կոնֆիգուրացիոն ֆայլի տեսքով։

Պատահական կոնֆիգուրացիաների գեներացիա

Պատահական կոնֆիգուրացիայով ֆայլերի գեներացիայի համար ես ընտրել եմ հետևյալ մոտեցումը։ Պատահակա թվերի օգնությամբ գեներացնել մի պատահական ինդեքս։ Այդ ինդեքսի հիման վրա հաշվել կոնֆիգուրացիայի հերթական համարը։ Գեներացնել ֆայլ ըստ ինդեքսի, իսկ համարը հիշել։ Իտերացիայի հաջորդ քայլում ֆայլը գեներացնելուց առաջ համարը որոնել նախորդ քայլերում հիշված համարների ցուցակում։ Եթե համարը արդեն կա, ապա պետք է կատարել նոր իտերացիա։

Ստորև բերված է Common Lisp լեզվով իրականացումը։

(defparameter *params* '() "Պարամետրերի ցուցակն է")
(defparameter *powers* '() "Արժեքների բազմությունների քանակները")
(defparameter *factors* '() "Ինդեքսի հաշվման բազմանդամի գործակիցները")
(defparameter *passed* '() "Արդեն գեներացրած տարբերակների համարները")

(defmacro calculate-powers (prs)
  `(mapcar #'(lambda (e) (list-length (second e))) ,prs))
(defmacro calculate-factors (pws)
  `(append (cdr (maplist #'(lambda (x) (apply #'* x)) ,pws)) '(1)))

(defun create-config (inx)
  (mapcar #'(lambda (a b) (cons (car a) (nth b (cadr a))))
          *params* inx))

(defun print-config (config ix)
  (let ((name (format nil "config~d.cfg" ix)))
    (with-open-file (out name :direction :output :if-exists :supersede)
      (dolist (cl config)
        (format out "~a = ~a~%" (car cl) (cdr cl))))))

(defun generate-files (max-num)
(dotimes (k max-num)
  (let* ((tup (mapcar #'random *powers*))
         (num (apply #'+ (mapcar #'* *factors* tup))))
    (when (not (member num *passed*))
      (print-config (create-config tup) k)
      (push num *passed*)))))

Tcl: QuickSort ալգորիթմի մասին

Անկեղ ասած, ես երբեք էլ չեմ հասկացել այս QuickSort կարգավորման ալգորիթմի էությունը։ Մինչև այն պահը, երբ «Learn You a Haskell for Great Good!» գրքում կարդացի այդ ալգորիթմի իրականացումը։ Ահա այն․

quicksort :: (Ord a) => [a] -> [a]  
quicksort [] = []  
quicksort (x:xs) =   
    let smallerSorted = quicksort [a | a <- xs, a <= x]  
        biggerSorted = quicksort [a | a <- xs, a > x]  
    in  smallerSorted ++ [x] ++ biggerSorted  

Մոտավորապես նույն ալգորիթմը կարելի է գրել նաև Tcl լեզվով։ Այստեղ ընտրվում է ցուցակի առաջին տարրը՝ H, ապա foreach ցիկլով ցուցակի մյուս տարրերը տրոհվում են երկու խմբի՝ H-ից մեծ, և H-ից փոքր կամ հավասար։ Այնուհետև ռեկուրսիվ եղանակով կարգավորվում են տրոհված խմբերն ու վերջում միավորվում իրար։

proc quickSort { elems } {
  # եթե ցուցակը դատարկ է, ապա կարգավորելու բան չկա
  if {0 == [llength $elems]} { return {} }
  set L [list]
  set G [list]
  # ընտրել ցուցակի առաջին տարրը
  set H [lindex $elems 0]
  # տրոհել մյուս տարրերը երկու խմբի
  foreach e [lrange $elems 1 end] {
    if {[expr $e < $H]} { lappend L $e } { lappend G $e }
  }
  # կարգավորել երկու խմբերը և միավորել որպես արդյունք
  return [concat [quickSort $L] $H [quickSort $G]]
}

Tcl: Սիմվոլիկ դիֆերենցում

Մի քանի օր առաջ թերթում էի Structure and Interpretation of Computer Programs գիրքը և աչքովս ընկավ մի օրինակ, որտեղ հաշվում էր պարզագույն մաթեմատիկական արտահայտությունների դիֆերենցիալը (2.3.2 Example: Symbolic Differentiation)։ Փորձեցի այն վերարտադրել Tcl լեզվով ու ահա թե ինչ ստացվեց։

Նախապես ասեմ, որ արտահայտություները սահմանափակված են միայն գումարում, հանում, բազմապատկում և բաժանում բինար գործողություններով, իսկ դիֆերենցիալը հաշվող differentiate ֆունկցիան սպասում է, որ իր մուտքին տվելու է արտահայտության պրեֆիքսային ներկայացումն ու այն փոփոխականը, ըստ որի կատարվում է դիֆերենցումը։

Արտահայտությունների դիֆերենցիալը հաշվելու համար օգտագործվում են հետևյալ բանաձևերը.

1. \(C\) հաստատունի համար. \[\frac{dC}{dx}=0,\]
2. \(x\) փոփոխականի համար. \[\frac{dx}{dx}=1,\]
3. \(u+v\) գումարի համար. \[\frac{d(u+v)}{dx}=\frac{du}{dx}+\frac{dv}{dx},\]
4. \(u\cdot v\) արտադրյալի համար. \[\frac{d(uv)}{dx}=\frac{du}{dx}v+\frac{dv}{dx}u,\]
5. \(\frac{u}{v}\) քանորդի համար. \[\frac{d}{dx}\Big(\frac{u}{v}\Big)=\frac{\frac{du}{dx}v-\frac{dv}{dx}u}{v^2},\]

differentiate ռեկուրսիվ պրոցեդուրայում պարզապես ծրագրավորված են նշված բանաձևերը։

proc differentiate { src var } {
  set H [lindex $src 0]
  # constant 
  if [regexp {\d+} $H] {
    return 0
  }
  # variable
  if [regexp {\w[\w\d]*} $H] {
    if [string equal $H $var] {
      return 1
    } else {
      return 0
    }
  }
  # addition, subtraction
  if [regexp {(\+|\-)} $H] {
    set L [differentiate [lindex $src 1] $var]
    set R [differentiate [lindex $src 2] $var]
    return [addi $H $L $R]
  }
  # multiplication, division
  if [regexp {(\*|\/)} $H] {
    set A [lindex $src 1]
    set B [lindex $src 2]
    set L [muli "*" [differentiate $A $var] $B]
    set R [muli "*" [differentiate $B $var] $A]
    if [string equal {*} $H] {
      return [addi "+" $L $R]
    }
    return [muli "/" [addi "-" $L $R] [muli "*" $B $B]]
  }
}

Բացի դիֆերենցիալի հաշվումից այս պրոցեդուրան կատարում է նաև մի քանի պարզեցումներ՝ հաշվի առնելով, որ \(0\cdot x=0\), \(1\cdot x=x\) և \(0 + x=x\)։ Այս պարզեցումները կատարվում են addi, muli և numeq պրոցեդուրաներով։

proc numeq { n v } {
  if [regexp {^\d+$} $n] { 
    return [expr $n == $v]
  }
  return false
}

proc addi { o a b } {
  if [numeq $a 0] { return $b }
  if [numeq $b 0] { return $a }
  if {[regexp {^\d+$} $a] && [regexp {^\d+$} $b]} {
    return [expr $a $o $b]
  }
  return [list $o $a $b]
}

proc muli { o a b } {
  if {[numeq $a 0] || [numeq $b 0]} { return 0 }
  if [numeq $a 1] { return $b }
  if [numeq $b 1] { return $a }
  if {[regexp {^\d+$} $a] && [regexp {^\d+$} $b]} {
    return [expr $a $o $b]
  }
  return [list $o $a $b]
}

* * *
Սա շատ լավ է։ Կարելի է կառուցել արտահայտությունների պրեֆիքսային ներկայացման օրինակներ և համոզվել, որ differentiate պրոցեդուրան իր անելիքն անում է։ Բայց հետաքրքիր խնդիր է նաև ինֆիքսային գրառմամբ տրված արտահայտությունից պրեֆիքսային տեսքը կառուցելը։ Այդ խդիրը լուծելու համար ես գրել եմ ստանդարտ շարահյուսական անալիզատոր, որը կառուցում է տրված արտահայտության աբստրակտ քերականական ծառը Tcl լեզվի ցուցակի տեսքով, որն էլ հենց արտահայտության պրեֆիքսային ներկայացում է։ Ահա այդ կոդը.

namespace eval Parser {
  variable tokens [list]
  variable position -1
  variable current {}

  # սա կարելի է ասել, որ լեքսիկական անալիզատորն է
  proc tokenizer { src } {
    set temp [regsub -all -- {(\+|\-|\*|\/|\(|\))} $src { \1 }]
    set temp [string trim [regsub -all -- {\s+} $temp { }]]
    return [split $temp { }]
  }

  # ստուգում է հերթական սիմվոլը, և եթե այն համաատասխանում է 
  # սպասվածին, ապա փոխարինում է հաջորդով, հակառակ դեպքում 
  # գեներացնում է քերականական սխալ
  proc next { tok } {
    variable tokens
    variable current
    variable position
    if [regexp $tok $current] {
      incr position
      set current [lindex $tokens $position]
    } else {
      error "Syntax error"
    }
  }

  # վերլուծում է գումարման ու հանման գործողությունները
  proc parseExpr { } {
    variable current
    set R [parseTerm]
    while {({+} eq $current) || ({-} eq $current)} {
      set op $current
      next {[\+\-]}
      set R [list $op $R [parseTerm]]
    }
    return $R
  }

  # վերլուծում է բազմապատկման ու բաժանման գործողությունները
  proc parseTerm { } {
    variable current
    set R [parseFactor]
    while {({*} eq $current) || ({/} eq $current)} {
      set op $current
      next {[\*\/]}
      set R [list $op $R [parseFactor]]
    }
    return $R
  }

  # վերլուծում է հաստատունները, փոփոխականները և 
  # խմբավորման փակագծերը
  proc parseFactor { } {
    variable current
    set res {}
    if [regexp {[0-9]+} $current] {
      set res $current
      next {[0-9]+}
    } elseif [regexp {\w[\w\d]*} $current] {
      set res $current
      next {\w[\w\d]*}
    } elseif [string equal {(} $current] {
      next {[\(]}
      set res [parseExpr]
      next {[\)]}
    }
    return $res
  }

  # այս պրոցեդուրայից է սկսվում անալիզատորի աշխատանքը,
  # այն ստանում է արտահայտության տեքստը, վերլուծում է ու
  # վերադարձնում է նրա պրեֆիքսային ներկայացումը
  proc parse { src } {
    variable tokens
    variable position
    variable current
    set tokens [tokenizer $src]
    lappend tokens EOS
    set position -1
    set current {}
    next {}
    return [parseExpr]
  }
}

* * *
prefixToInfix պրոցեդուրան լուծում է հակառակ խնդիրը։ Այն իր արգումենտում ստանում է արտահայտության պրեֆիքսային ներկայացումը և վերադարձնում է ինֆիքսայինը։ Այս տարբերակով, իհարկե, այն արտահայտության մեջ դնում է ավելորդ փակագծեր, բայց այդ թերությունը հեշտությամբ կարելի է շտկել։

proc prefixToInfix { exp } {
  set H [lindex $exp 0]
  if [regexp {^\d+$} $H] {
    return $H
  }
  if [regexp {\w[\w\d]*} $H] {
    return $H
  }
  if [regexp {(\+|\-|\*|\/)} $H _ op] {
    set L [prefixToInfix [lindex $exp 1]]
    set R [prefixToInfix [lindex $exp 2]]
    return "($L $op $R)"
  }
}

Tcl ցուցակների հետ աշխատանքը

Ցուցակները Tcl լեզվում կառուցվում են list պրոցեդուրայով։ Այն ստանում է արգումենտների ցուցակ, հաշվարկում է դրանք և արդյունքներից կառուցվում է նոր ցուցակ։ Օրինակ,

set a [list [expr 1 + 2] 7 [expr 34 * 2]]

պրոցեդուրայի կատարումը a փոփոխականին կվերագրի {3 7 68} ցուցակը։ Հաստատուններից ցուցակ կարելի է կառուցել դրանք պարզապես թվարկելով "{" և "}" փախագծերի միջև։ Օրինակ,

set b {1 2 3 4 5}

Ցուցակի ամեն մի տարրն իր հերթին կարող է լինել ցուցակ։ Այդպիսին է օրինակ {a b c {3 4} d {5 6}} ցուցակը, որի տարրերից երկուսը ցուցակներ են։

Որևէ տողից կարելի է ցուցակ ստանալ, այն կտրտելով տրված բաժանիչով։ Օրինակ, եթե տրված է "a,b,c,d" տողը, ապա նրանից {a b c d} ցուցակը կարող ենք ստանալ ահա այսպես.

set c [split "a,b,c,d" ,]

Իսկ եթե տողում բաժանիչները մի քանիսն են, օրինակ ինչպես "a,b:c;d" տողում, ապա նույն {a b c d} ցուցակը կարելի է ստանալ split պրոցեդուրայի երկրորդ արգումենտում տալով բոլոր բաժանիչները.

set c [split "a,b,c,d" ",:;"]

split պրոցեդուրայի հակառակ գործողությունն է կատարում join պրոցեդուրան, որը տրված ցուցակի տարրերը տարրերը միացնում է իրար և ստանում տող՝ տարրի միջև ավելացնելով տրված տողը։ Օրինակ, {1 2 3 4} ցուցակից "1 + 2 + 3 + 4" տողը ստանալու համար կարող ենք գրել

set d [join {1 2 3 4} { + }]

Մի քանի ցուցակներ իրար կցելու և նոր ցուցակ ստանալու համար է նախատեսված concat պրոցեդուրան։ Օրինակ, {6 7 8 9}, {g h i j} և {"a 1" "b 2" "c 3"} ցուցակներից մի նոր ցուցակ կարող ենք ստանալ՝ կատարելով հետևյալ հրամանը.

set e [concat {6 7 8 9} {g h i j} {"a 1" "b 2" "c 3"}]

կատարման արդյունքում կստացվի {6 7 8 9 g h i j "a 1" "b 2" "c 3"} ցուցակը։

Ցուցակ կարելի է կազմել նաև տրված տարրը lrepeat պրոցեդուրայի օգնությամբ տրված քանակով կրկնելով։ Օրինակ, եթե ուզում ենք կառուցել տաս z տառերից բաղկացած ցուցակ, ապա պետք է գրել.

set u [lrepeat 10 z]

Տրված ցուցակի պոչից նոր տարր կցելու համար lappend պրոցեդուրայի առաջին արդումենտում պետք է տալ այն ցուցակը, որին ուզում ենք կցել տարրերը, իսկ հաջորդ արգումենտներով՝ կցվող տարրերը։ Օրինակ,

set a [list 1 2 3]
lappend a 4 5 6

Առաջին տողը կատարվելիս a փոփոխականի վերագրվում է {1 2 3} ցուցակը։ Հաջորդ տողը կատարելիս արդեն a-ն փոխվում է՝ ստանալով {1 2 3 4 5 6} արժեքը։ lappend պրոցեդուրան փոխում է իր առաջին արգումենտում տրված ցուցակը, բայց նաև վերադարձնում է նոր ստեղծված ցուցակը։

Ցուցակի տարրերի միջև նոր տարրեր խցկելու համար պետք է օգտագործել linsert պրոցեդուրան։ Նրա առաջին արգումենտը ցուցակն է, որում պետք է խցկել նոր տարրեր, երկրորդը ինդեքս է՝ այն տարրի ինդեքսը, որից առաջ պետք է խցկել տարրերը, հաջորդ արգումենտներով արդեն տրվում են ավելացվող տարրերը։ Օրինակ, եթե {1 2 3} ցուցակի սկզբից 8 և 9 տարրերն ավելացնելու համար ինդեքսը պետք է տալ զրո.

linsert {1 2 3} 0 8 9

Այս հրամանը կվերադարձնի {8 9 1 2 3} ցուցակը։ Իսկ {1 8 9 2 3} ցուցակը ստանալու համար պետք է գրել հետևյալը.

linsert {1 2 3} 1 8 9

Ցուցակի վերջից տարրերն ավելացնելու համար (մոտավորապես այնպես, ինչպես անում է lappend պրոցեդուրան) ինդեքսի փոխարեն պետք է տալ end բառը.

linsert {1 2 3} end 8 9

Ցուցակի տարրերը հեռացնելու կամ այլ տարրերով փոխարինելու համար է նախատեսված lreplace պրոցեդուրան։ Այն առաջին արգումենտում ստանում է ցուցակը, որի տարրերը պետք է փոխարինել, երկրորդ և երրորդ արգումենտով ստանում է փոխարինվող տարրերի միջակայքի ինդեքսները, իսկ հաջորդ արգումենտներով ստանում է այն տարրերը, որոնք պետք է տեղադրվեն հեռացվածների փոխարեն։ Օրինակ, {1 2 3 4 5 6 7} ցուցակից {1 2 a b c d 6 7} ցուցակը ստանալու համար պետք է գրել.

lreplace {1 2 3 4 5 6 7} 2 4 a b c d

Նույն այդ ցուցակի վերջին երկու տարրերը հեռացնելու համար էլ պետք է գրել.

lreplace {1 2 3 4 5 6 7} end-2 end

Ցուցակի տարրերից որևէ մեկի արժեքը մեկ այլ արժեքով փոխարինելու համար պետք է lset պրոցեդուրային տալ ցուցակը ներկայացնող փոփոխականի անունը, տարրի ինդեքսը և նոր արժեքը։ Օրինակ, եթե a փոփոխականին վերագրված է {1.2 3.4 5.6 7.8 9.0} ցուցակը, և ուզում ենք 7.8 արժեքը փոխարինել 8.7 արժեքով, ապա կարող ենք գրել.

set a {1.2 3.4 5.6 7.8 9.0}
lset a 3 8.7

lset պրոցեդուրայով կարելի է փոփոխել նաև ներդրված ցուցակների տարրերը։ Այս դեպքում ինդեքսի փոխարեն պետք է տալ ինդեքսների ցուցակ։ Օրինակ, եթե b փոփոխականին վերագրված է {{x0 1.2} {x1 3.4} {x2 5.6} {x3 7.8} {x4 9.0}} ցուցակը, և մեզ պետք է 5.6 արժեքը փոխարինել 0.0 արժեքով, ապա կարող ենք գրել.

set b {{x0 1.2} {x1 3.4} {x2 5.6} {x3 7.8} {x4 9.0}}
lset b {2 1} 0.0

Եթե պետք է ստանալ ցուցակի տրված ինդեքսով տարրը, ապա lindex պրոցեդուրային պետք է տալ ցուցակը և պահանջվող տարրի ինդեքսը։ (Եթե որևէ ինդեքս տրված չէ, ապա այս պրոցեդուրան վերադարձնում է ամբողջ ցուցակը։) Օրինակ, հետևյալ արտահայտությունը k փոփոխականին վերագրում է {x1 3.4}.

# set b {{x0 1.2} {x1 3.4} {x2 5.6} {x3 7.8} {x4 9.0}}
set k [lindex $b 1]

Եթե հարկավոր է k փոփոխականին վերագրել 3.4 արժեքը, ապա ինդեքսի փոխարեն պետք է տալ ինդեքսների ցուցակ (ինչպես lset պրոցեդուրայի դեպքում).

set k [lindex $b {1 1}]

Մի տարրի փոխարեն ցուցակի տարրերի տրված ինդեքստներով սահմանափակված հատվածը կարելի է ստանալ lrange պրոցեդուրայով։ Այն ստանում է ցուցակը, պահանջվող հատվածի սկզբի և վերջի ինդեքսները. ընդ որում, վերջին ինդեքսով որոշվող տարրը արդյուքի մեջ չի ներառվում։ Օրինակ, {a b c d e f g h} ցուցակից def բառը ստանալու համար պետք է գրել.

join [lrange {a b c d e f g h} 3 5] {}

Ցուցակում տրված շաբլոնին համապատասխանող տարրի առկայությունը որոշելու համար է նախատեսված lsearch պրոցեդուրան։ Սա վերադարձնում է որոնվող տարրի ինդեքսը, կամ -1 արժեքը՝ եթե որոնումն անհաջող է ավարտվել։ Օրինակ, ենթադրենք, թե a փոփոխականին վերագրված է {1.2 3.4 5.6 7.8 3.4 9.0} ցուցակը։ 7.8 արժեքով տարրի ինդեքսը որոշելու համար պետք է գրել.

set k [lsearch -real $a 7.8]

որտեղ -real բանալին ցույց է տալիս, որ որոնման ժամանակ արժեքները համեմատվելու են որպես իրական թվեր։ Ցուցակը 3.4 արժեքը պարունակում է երկու անգամ և այդ երկու տարրերի ինդեքսները որոշելու համար lsearch պրոցեդուրայի կանչի ժամանակ պետք է տալ -all բանալին, և այս դեպքում կստանանք ինդեքսների ցուցակ։

set k [lsearch -real -all $a 3.4]

Այժմ ենթադրենք, թե b փոփոխականի հետ կապված է {c7 b4 a0 B6 a2 c8 a1 b3 B5} ցուցակը, և ուզում ենք ստանալ այն տարրերը, որոնց սկսվում են a տառով։

puts [lsearch -ascii -all -inline -regexp $b {^a}]

Այս արտահայտության մեջ -ascii բանալին նշում է, որ ցուցակի տարրերը տողեր են, -inline բանալին ցույց է տալիս, որ պետք է վերադարձնել ոչ թե տառերը, այլ գտնված տարրերը։ -regexp բանալին ասում է, որ որոնման ժամանակ տարրերը պետք է համապատասխանեմ տրված կանոնավոր արտահայտությանը, իսկ {^a} արտահայտությունը ճանաչում է բոլոր այն տարրերը, որոնց առաջին տարրը a է։ Եթե հարկավոր է, որ որոնում կատարելիս անտեսվեն մեծատառերի ու փոքրատառերի տարբերությունները, ապա պետք է գրել նաև -nocase բանալին։

Ցուցակները կարդավորելու (sort) համար է lsort պրոցեդուրան: Օրինակ, նախորդ b ցուցակը այբբենական եղանակով կարգավորելու համար պետք է գրել.

puts [lsort -nocase -ascii $b]

Նույն ցուցակը հակառակ կարգով կարգավորելու համար հրամանին պետք է ավելացնել -decreasing բանալին։ Եթե հարկավոր է կարգավորման ժամանակ ցուցակից հեռացնել կրկնությունները, ապա պետք է տալ նաև -unique բանալին։

Ցուցակը շրջելու համար պետք է օգտագործել lreverse պրոցեդուրան: Այն ստանում է ցուցակը և վերադարձնում է մեկ այլ ցուցակ, որում նախնականի տարրերն են՝ թվարկված հակառակ հաջորդականությամբ։ llength պրոցեդուրան պարզապես վերադարձնում է տրված ցուցակի տարրերի քանակը։

Tcl: Օբյեկտներին կողմնորոշված ծրագրավորման օրինակ

Մի քանի օր առաջ նորությունների կայքում կարդացի Tcl ծրագրավորման լեզվի 8.6 (Tcl 8.6) տարբերակի թողարկման մասին։ Հաղորդագրության մեջ, ի թիվս այլ կետերի, նշվում էր նաև, որ TclOO փաթեթը արդեն հանդիսանում է լեզվի բաղկացուցիչ մաս՝ որպես օբյեկտներին կողմնորոշված ծրագրավորման հիմնական միջոց։

Փորձեցի մաթեմատիկական արտահայտությունների օրինակով գրել մի կարճ ծրագիր՝ օգտագործելով հենց այդ TclOO ընդլայնումը։ Այս օրինակս ընդհանուր պատկերացում տալիս է դասերի, կոնստրուկտորների, մեթոդների ու դաշտերի դահմանման մասին։

Եվ այսպես, նախ սահմանեմ expression աբստրակտ դասը, որը ներկայացնում է միակ evaluate մեթոդը։

oo::class create expression {
  method evaluate {} {}
}

Այստեղ oo::class հրամանի create ենթահրամանով սահմանվում է դասը։ method հրամանով սահմանվում են դասի մեթոդները (այն շատ նման է proc հրամանին)։

Որպես expression աբստրակտ դասի առաջին ընդլայնում սահմանեմ number դասը։ Նշելու համար, որ այն expression դասի ընդլայնում է (ենթադաս է), օգտագործվել է superclass հրամանը՝ արգումենտում expression դասի անունով։

oo::class create number {
  superclass expression
  variable value
  constructor { v } {
    my variable value
    set value $v
  }
  method evaluate {} {
    my variable value
    return $value
  }
}

variable հրամանով հայտարարվում են դասի դաշտերը։ Այս դասի համար ես նախատեսել եմ թվի արժեքը ներկայացնող value դաշտը։ constructor հրամանով սահմանվում է դասի կոնստրուկտորը։ Այն ստանում է արգումենտների ցուցակ և կոնստրուկտորի մարմինը։ Դասի մեթոդներում, ինչպես նաև կոնստրուկտորում դասի դաշտերը (փոփոխականները) մատչելի են դառնում my հրամանով։ "my variable value" տողը հնարավորություն է տալիս կոնստրուկտորի մարմնում աշխատել value փոփոխականի հետ։ number դասի համար իրականացված evaluate մեթոդը պարզապես վերադարձնում է value փոփոխականի արժեքը։

expression դասի երկրորդ ընդլայնումը ունար գործողությունները մոդելավորող unaryex դասն է։ Սրա կոնստրուկտորը ստանում է ունար գործողության նշանակումը և այն ենթաարտահայտությունը, որի վրա պետք է կիրառել գործողությունը։

oo::class create unaryex {
  superclass expression
  variable oper subex
  constructor { op ex } {
    my variable oper subex
    set oper $op
    set subex $ex
  }
  method evaluate {} {
    my variable oper subex
    set res [$subex evaluate]
    if {$oper eq "-"} {
      set res -$res
    }
    return $res
  }
}

evaluate մեթոդը նախ հաշվում է ենթաարտահայտության արժեքը, ապա, եթե գործողությունը "-" է, վերադարձնում է արժեքի բացասումը։

Եվ վերջապես, expression դասի մի ընդլայնում ևս։ Սահմանեմ binaryex դասը, որը մոդելավորում է բինար "+", "-", "*", "/" և "%" գործողությունները։

oo::class create binaryex {
  superclass expression
  variable oper subex0 subex1
  constructor { op exo exi } {
    my variable oper subex0 subex1
    set oper $op
    set subex0 $exo
    set subex1 $exi
  }
  method evaluate {} {
    my variable oper subex0 subex1
    set res0 [$subex0 evaluate]
    set res1 [$subex1 evaluate]
    set result 0
    switch $oper {
      "+" { set result [expr $res0 + $res1] }
      "-" { set result [expr $res0 - $res1] }
      "*" { set result [expr $res0 * $res1] }
      "/" { set result [expr $res0 / $res1] }
      "%" { set result [expr $res0 % $res1] }
    }
    return $result
  }
}

Այստեղ առանձնապես բացատրելու բան չկա. օգտագործված են Tcl լեզվի պարզագույն հրամաններ։

* * * Դասերի հիերարխիան ստուգելու համար կազմեմ "(10 + 2 - 6) * 5 / -3" արտահայտության հաշվարկի ծրագիրը (որի արժեքը -10 է)։

proc example0 {} {
  # (10 + 2 - 6) * 5 / -3 = -10
  set n10 [number new 10]
  set n2 [number new 2]
  set n6 [number new 6]
  set n5 [number new 5]
  set n3 [number new 3]
  
  set u0 [unaryex new "-" $n3]
  
  set b0 [binaryex new "+" $n10 $n2]
  set b1 [binaryex new "-" $b0 $n6]
  set b2 [binaryex new "*" $b1 $n5]
  set b3 [binaryex new "/" $b2 $u0]
  
  set result [$b3 evaluate]
  return $result
}

* * * Վերջում նշեմ, որ բոլոր փորձարկումներն արել եմ Tcl լեզվի ActiveTcl 8.6 իրականացմամբ։

Tcl: Բառարանների օգտագործումը

Խնդիրը

Տրված է որևէ գեղարվեստական ստեղծագործության տեքստ։ Կազմել տեքստում հանդիպող բառերի հաճախության բառարան, որտեղ ամեն մի բառին համապատասխանեցված է տեքստում նրա հանդիպելու քանակը։ Հաշվել տեքստի առանձին բառերի քանակի հարաբերությունը բոլոր բառերի քանակին։ Արտածել տաս ամենաշատ օգտագործված բառերի խմբերը։ Արտածել տաս ամենաերկար բառերը և նրանց հանդիպելու քանակը։ Արտածել միայն մեկ անգամ հանդիպող բառերի ցուցակը։

Լուծումը

Դատարկ բառարանը ստեղծվում է dict հրամանի create ենթահրամանով: set հրամանը տրված փոփխականին (օբյեկտին, տեղին) վերագրում է տրված արժեքը։ Ստեղծենք words բառարանը, որն արտապատկերում է տեքստի բառերը տեքստում նրանց հանդիպելու քանակին.

set words [dict create]

Տող առ տող կարդանք տեքստային ֆայլը և նրա բառերն ավելացնենք հաճախությունների բառարանում։ open հրամանը տրված ֆայլը բացում է տրված ռեժիմով (գրել, կարդալ և այլն) և վերադարձնում է ֆայլի դեսկրիպտոր։ gets հրամանը ֆայլից կարդում և վերադարձնում է մեկ տող։ Եթե նրան տրված է երկրորդ արգումենտը, ապա կարդացած տողը վերագրվում է այդ արգումենտին, իսկ ֆունկցիան վերադարձնում է կարդացած նիշերի քանակը։ regsub հրամանը տողում փոփոխություններ է կատարում ըստ տրված կանոնավոր արտահայտության։ string հրամանի tolower ենթահրամանը տրված տողի բոլոր մեծատառերը դարձնում է փոքրատառ։ foreach հրամանը իտերացիա (ցիկլ) է կատարում տրված ցուցակով։ split հրամանը տողը կտրտում է՝ օգտագործելով տրված բաժանիչները։ string հրամանի length ենթահրամանը վերադարձնում է տողի երկարությունը։ if հրամանը կատարում է մարմնում տրված հրամանները, եթե պայմանը ճշմարիտ է։ dict հրամանի exists ենթահրամանը ստուգում է արդյո՞ք տրված բառարանում առկա է տրված բանալին, իսկ set ենթահրամանը բառարանում ավելացնում է տրված բանալի-արժեք զույգը։ dict հրամանի մեկ այլ, incr ենթահրամանը տրված արժեքն ավելացնում է բառարանի տրված բանալիին համապատասխան արժեքին։ close հրամանը փակում է բացած ֆայլը։

# բացել տեքստային ֆայլը կարդալու համար
set fin [open {martin-eden-jack-london.txt} r]
while {[gets $fin line] >= 0} {
  # հեռացնել բոլոր տառ չհանդիսացող սիմվոլները
  set line [regsub -all -- {\W+} $line { }]
  # տողի բոլոր սիմվոլները դարձնել փոքրատառ
  set line [string tolower $line]
  # կտրտել տողը և անցնել բառերով
  foreach wd [split $line { }] {
    # դիտարկել միայն մեկից մեծ երկարությամբ բառերը
    if {[string length $wd] > 1} then {
      # եթե բառարանում չկա տվյալ բառին համապատասխան գրառում
      if {![dict exists $words $wd]} then {
        # ավելացնել այն՝ զրո արժեքով
        dict set words $wd 0
      }
      # մեկով ավելացնել դիտարկվող բառի ցուցիչը
      dict incr words $wd
    }
  }
}
# փակել տեքստային ֆայլը
close $fin

dict հրամանի size ենթահրամանը վերադարձնում է բառարանի տարրերի քանակը, իսկ for ենթահրամանը իտերացիա է կազմակերպում բառարանի բանալի-արժեք զույգերով։ incr հրամանը տրված փոփոխականին գումարում է տրված արժեքը։

# ունիկալ (առանձին) բառերի քանակը
set uniwords [dict size $words]
# բոլոր բառերի քանակի հաշվարկը
set allwords 0
# անցում բառարանի բանալի-արժեք զույգերով
dict for {k v} $words {
  incr allwords $v
}
# առանձին բառերի քանակի հարաբերությունը բոլոր բառերի քանակի
puts "$uniwords / $allwords = [expr 1.0 * $uniwords / $allwords]"

Նախապատրաստենք մի նոր բառարան, որն արտապատկերում է քանակը բառերի ցուցակին։ Այն օգտագործվելու է տրված քանակով բառերի ցուցակի ստացման համար։ dict հրամանի lappend ենթահրամանը տրված արժեքը կցում է բառարանի տրված բանալուն համապատասխանեցված ցուցակին։

set counts [dict create]

# անցում բառարանի բանալի-արժեք զույգերով
dict for {k v} $words {
  # եթե բառարանում հերթական քանակին համապատասխան բառերի ցուցակը դատարկ է
  if {![dict exists $counts $v]} then {
    # ապա ստեղծել նոր արտապատկերում դատարկ ցուցակով
    dict set counts $v [list]
  }
  # դիտարկվող բառն ավելացնել համապատասխան թվի ցուցակում
  dict lappend counts $v $k
}

lrange հրամանը վերադարձնում է տրված ցուցակի մի հատվածը՝ նորից ցուցակի տեսքով։ lsort հրամանը կարգավորում է ցուցակի տարրերը տրված պայմանով։ dict հրամանի keys ենթահրամանը վերադարձնում է բառարանի բանալիների ցուցակը։ puts հրամանը ստանդարտ արտածման հոսքին է արտածում տրված արժեքը։

# տաս ամենահաճախ օգտագործված բառերը
foreach num [lrange [lsort -decreasing -integer [dict keys $counts]] 0 10] {
  puts "[dict get $counts $num] : $num"
}

proc հրամանով սահմանվում են նոր պրոցեդուրաներ (կամ ֆունկցիաներ)։ expr հրամանը հաշվարկում և վերադարձնում է իր արգումենտում տրված արտահայտության արժեքը։ return հրամանը նախատեսված է ֆունկցիայից արժեքի վերադարձի համար։

# մի ֆունկցիա, որը տողերի կարգի հարաբերություն է սահմանում ըստ երկարության
proc cmplen {a b} {
  return [expr [string length $a] < [string length $b]]
}

lsort հրամանը կարող է -command պարամետրով ստանալ կարգի հարաբերությունը։

# տաս ամենաերկար բառերը և նրանց հաճախությունները 
foreach wd [lrange [lsort -command cmplen [dict keys $words]] 0 10] {
  puts "$wd : [dict get $words $wd]"
}

dict հրամանի get ենթահրամանը վերադարձնում է բառարանի տրված բանալուն համապատասխանեցված արժեքը։

# միայն մեկ անգամ օգտագործված բառերը
puts [dict get $counts 1]

exit հրամանով ավարտվում են Tcl ծրագրերը։

exit 0