Խնդիրը

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

Լուծումը

Դատարկ բառարանը ստեղծվում է 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

Սկզբնաղբյուրը։ http://armenbadal.blogspot.com/2012/12/tcl.html