Thursday, February 28, 2013

Բինար ծառեր նկարելու մասին

Մի քանի գրառումներիս մեջ ինձ հարկավոր էր պատկերել բինար ծառեր՝ որոշ ալգորիթմների աշխատանքը ցուցադրելու համար։ Սկզբում ես նկարում էի թղթի վրա, ապա, սկաների օգնությամբ թվայնացնելուց հետո, տեղադրում էի գրառման մեջ։ Բայց դա շատ անհարմար եղանակ է, մանավանդ երբ նկարները շատ են ու մատկերում են ալգորիթմի հաջորդական քայլեր։ Հետո որոշեցի գրել ծրագիր, որը ծառ պատկերը կարտածի որևէ գրաֆիկական ֆորմատով։ Postscript, MetaPost և SVG տարբերակներից ընտրեցի վերջինը, որովհետև․ ա) այն շատ պարզ կառուցվածք ունի, գրաֆիկական պրիմիտիվները ներկայացված են XML լեզվով, որում գեներացնելուց հետո կարելի շտկումներ կատարել, բ) նկարները կարելի է դիտել ժամանակակից կամայական բրաուզերի մեջ։

Երբ ինտերնետում փնտրում էի ծառ նկարելու ալգորիթմի մասին տեղեկություններ, գտա բազմաթիվ գրառումներ, սլայդներ, հոդվածներ, որոնցում դիտարկվում էին ծառերը նկարելու առանձնհատկություները (տարածքի օպտիմալ օգտագործում, կատարման արագություն և այլն)։ Բայց քանի որ այդպիսի փիլիսոփայություններն ինձ չեն հետաքրքրում, ընտրեցի ամենապարզ ալգորիթմը, որը, ինչքան հասկացա, առաջարկել է Դ․ Կնուտը։ Այդ ալգորիթմի կառուցվածքը շատ պարզ է.
1.  Let x = 0
2.  Procedure DrawTree( tree, y )
3.    If Left( tree ) <> Nil Then
4.      DrawTree( Left( tree ), y + 1 )
5.    DrawNode( Data( tree, x, y ) )
6.    Let x = x + 1
7.    If Right( tree ) <> Nil Then
8.      DrawTree( Right( tree ), y + 1 )
9.  End
Այստեղ իրականացված է բինար ծառի ձախ-արմատ-աջ տիպի անցում, որտեղ արմատը նկարվում է ընթացիկ մակարդակի` y, իր կարգին համապատասխան՝ x, դիրքում։ Ստորև բերված նկարում կապույտ գծերով նկարված ու համարակալված են ծառը նկարելու ժամանակ x փոփոխականի հաջորդական արժեքները, իսկ կարմիր գծերով՝ y փոփոխականինը (մակարդակները)։
65 54 41 32 24 20 18 16 12 10 7 3 1 2 3 4 5 6 7 8 9 10 11 12 1 2 3 4
Ես այս սխեման օգտագործել եմ Common Lisp լեզվով draw-tree փաթեթը սահմանելու համար, որը տրամադրում է ծառի ցուցակային ներկայացումից SVG պատկեր գեներացնող draw-as-svg ֆունկցիան և նկարող ալգորիթմի մի քանի պարամետրեր վերասահմանող setup ֆունկցիան։
(defpackage :draw-tree
  (:use :common-lisp)
  (:export :setup
           :draw-as-svg))

(in-package :draw-tree)
Հետո սահմանում եմ չորս պարամետրեր, որոնք օգտագործվում են ծառի հանգույցները և դրանք միացնող գծերը պատկերելու համար։
(defvar *node-radius* 12 "ծառի հանգույցը պատկերող օղակի շառավիղը")
(defvar *font-size* 12 "տառերի չափը")
(defvar *x-scale* 30 "մասշտաբը X-երի առանցքով")
(defvar *y-scale* 30 "մասշտաբը Y-ների առանցքով")
Նկարելուց առաջ կարելի է setup ֆունկցիայի անվանված արգումենտներով փոփոխել այս պարամետրերից մեկը կամ մի քանիսը։
(defun setup (&key (node-radius 12) (font-size 12) (x-scale 30) (y-scale 30))
  (setq *node-radius* node-radius
        *font-size* font-size
        *x-scale* x-scale
        *y-scale* y-scale))
Հետևյալ հաստատունները SVG ֆայլը գեներացնելու ժամանակ օգտագործվելու են որպես format ֆունկցիայի արգումենտներ։
(defconstant +svg-header+
  "<svg xmlns='http://www.w3.org/2000/svg' version='1.1' width='~d' height='~d'>~%")
(defconstant +svg-circle+
  "    <circle cx='~d' cy='~d' r='~d'/>~%")
(defconstant +svg-text+
  "    <text x='~d' y='~d'>~d</text>~%")
(defconstant +svg-line+
  "    <line x1='~d' y1='~d' x2='~d' y2='~d'/>~%")
Նկարելու ալգորիթմն իրականացված է այնպես, որ նախ հավաքվում են ֆայլը գեներացնելու համար անհրաժեշտ տվյալները, ապա դրանք խմբավորված գրվում են նպատակային ֆայլում։ Հետևյալ փոփոխականները ծառայում են միջանկյալ տվյալները պահելու համար։
(defparameter *edges* '() "հանգույցները միացնող գծերը")
(defparameter *nodes* '() "հանգույցները պատկերող շրջանակները")
(defparameter *texts* '() "շրջանակի մեջ գրված տեքստը")
(defparameter *max-x* 0 "ամենամեծ x կոորդինատը")
(defparameter *max-y* 0 "ամենամեծ y կոորդինատը")
node-svg ֆունկցիան ստեղծում է SVG պատկերի երկու թեգեր՝ circle և text, որոնք ներկայացնում են ծառի հանգույցը։ Այս ֆունկցիան հաշվում է նաև ամենամեղ x և y կոորդինատները։
(defun node-svg (xy text)
  (let ((x (* *x-scale* (car xy))) (y (* *y-scale* (cdr xy))))
    (push (format nil +svg-circle+ x y *node-radius*) *nodes*)
    (push (format nil +svg-text+ x (+ 4 y) text) *texts*)
    (setq *max-x* (max *max-x* x) *max-y* (max *max-y* y))))
edge-svg ֆունկցիան ստեղծում է SVG պատկերի line թեգը, որը ներկայացնում է երկու հանգույցները միացնող կողը։
(defun edge-svg (xyb xye)
  (let ((xb (* *x-scale* (car xyb))) (yb (* *y-scale* (cdr xyb)))
        (xe (* *x-scale* (car xye))) (ye (* *y-scale* (cdr xye))))
    (push (format nil +svg-line+ xb yb xe ye) *edges*)))
Եվ վերջապես, կնուտի ալգորիթմը։ calculate-coordinates ֆունկցիան անցնում է ծառի հանգույցներով և ամեն մի հանգույցում գրված տվյալը փոխարինում է (data (x . y)) տեսքի ցուցակի։ Այս ֆունկցիայի աշխատանքի արդյունքում ստացվում է նոր ծառ՝ կոորդինատներով հարստացված հանգույցներով։
(defparameter *pos* 0)

(defun calculate-coordinates (tree level)
  (when tree
    (let ((h (car tree)) (l (cadr tree)) (r (caddr tree)))
      (when l (setf l (calculate-coordinates l (1+ level))))
      (setf h (list (cons *pos* level) h))
      (incf *pos*)
      (when r (setf r (calculate-coordinates r (1+ level))))
      (list h l r))))
generate-svg-edges և generate-svg-nodes ֆունկցիաները նորից անցնում են ծառի վրայով ու խմբավորում են SVG ֆայլը գեներացնելու համար անհրաժեշտ տվյալները։ Երևի կարելի է այս երկու ֆունկցիաները կոմբինացնել calculate-coordinates ֆունկցիայի հետ, որով կնվազեն ալգորիթմի քայլերը, բայց այս պահին ես իրականացրել եմ այս եղանակով։
(defun generate-svg-edges (tree)
  (when tree
    (let ((h (car tree)) (l (cadr tree)) (r (caddr tree)))
      (when l
        (generate-svg-edges l)
        (edge-svg (car h) (caar l)))
      (when r
        (generate-svg-edges r)
        (edge-svg (car h) (caar r))))))

(defun generate-svg-nodes (tree)
  (when tree
    (let ((h (car tree)) (l (cadr tree)) (r (caddr tree)))
      (when l (generate-svg-nodes l))
      (node-svg (car h) (cadr h))
      (when r (generate-svg-nodes r)))))
draw-as-svg ֆունկցիան նախապատրաստում է ժամանակավոր փոփոխականները, հաշվարկում է ծառի գագաթների կոորդինատները, ապա հավաքած ինֆորմացիան արտածում է տրված անունով ֆայլի մեջ։
(defun draw-as-svg (tree out-file)
  (setq *pos* 1
        *edges* '()
        *nodes* '()
        *texts* '())
  (let ((antree (calculate-coordinates tree 1)))
        (generate-svg-edges antree)
        (generate-svg-nodes antree))
    (with-open-file (osvg out-file :direction :output :if-exists :supersede)
      (format osvg +svg-header+ (+ *max-x* *x-scale*) (+ *max-y* *y-scale*))
      (format osvg "  <g fill='white' stroke='black' stroke-width='2'>~%")
      (dolist (e *edges*) (princ e osvg))
      (dolist (n *nodes*) (princ n osvg))
      (format osvg "  </g>~%~%")
      (format osvg "  <g text-anchor='middle' font-size='~d' stroke-width='0'>~%" *font-size*)
      (dolist (x *texts*) (princ x osvg))
      (format osvg "  </g>~%")
      (format osvg "</svg>~%")))
* * *
Վերջում մի օրինակ. պատահական տվյալներից կառուցված AVL ծառ՝ նկարված այս ծրագրով.
976 965 961 956 950 940 902 856 809 792 738 702 682 675 672 671 642 625 592 590 546 545 533 529 523 504 490 489 477 451 420 416 317 287 272 270 249 228 222 207 176 49 44 29 26

Saturday, February 23, 2013

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

Խնդիրը

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

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*)))))

Friday, February 22, 2013

Common Lisp: Բալանսավորված բինար ծառեր

Գրառումներից մեկում ես ներկայացրեցի բինար որոնման ծառի իրականացումը որպես չփոփոխվող տվյալների կառուցվածք։ Այս անգամ էլ բալանսավորված բինար ծառերը ներկայացնելու համար ընտրել եմ այդ եղանակը, բայց որպես ցուցադրման համար ընտրել եմ Common Lisp լեզուն (Scheme լեզվի փոխարեն)։
ՈՒզում եմ հատկապես շեշտել, որ այս գրառման նպատակը բալանսավորված ծառերի հետ կապված ալգորիթմների ցուցադրությունը չէ։ Միակ նպատակը, որ ես դրել եմ իմ առաջ, դա Common Lisp լեզվով հայալեզու նյութերի ստեղծումն ու տարածումն է։ Նաև նկատելի է, որ բոլոր ներկայացված ալգորիթմներն արդյունավետությամբ չեն առանձնանում։
* * *
Սահմանումներ։ Common Lisp լեզվով ներկայացված բինար ծառի հանգույցն ունի երեք անդամ, որոնցից առաջինն ատոմ է և հանդիսանում է հանգույցում գրված արժեքը։ Երկրորդ ու երրորդ տարրերը ցուցակներ են, որոնք ներկայացնում են հանգույցի համապատասխանաբար ձախ և աջ ենթածառերը։ node-p պրեդիկատը ստուգում է, որ տրված ցուցակը ծառի հանգույց է․
(defun node-p (tree)
  (and (= 3 (list-length tree))
       (atom (car tree))
       (listp (cadr tree))
       (listp (caddr tree))))
Ծառի տերևը նույնպես հանգույց է, որի ենթածառերի փոխարեն nil արժեքն է։ leaf-p պրեդիկատը ստուգում է, որ տրված ցուցակը ծառի տերև է․
(defun leaf-p (tree)
  (and (node-p tree)
       (null (cadr tree))
       (null (caddr tree))))
Ծառի բարձրությունը նրա արմատից մինչև տերևներն ընկած ճանապարհներից ամենաերկարի երկարությունն է։ Այդ արժեքը կարելի է հաշվել tree-height ռեկուրսիվ ֆունկցիայով։
(defun tree-height (tree)
  (if tree
      (1+ (max (tree-height (cadr tree))
          (tree-height (caddr tree))))
      0))
Մոտավորապես նույն եղանակով կարելի է հաշվել ծառի բոլոր տարրերի քանակը.
(defun count-nodes (tree)
  (if tree
      (+ 1 (count-nodes (cadr tree))
           (count-nodes (caddr tree)))
      0))
Հանգույցի ձախ (L) ու աջ (R) ենթածառերի բարձրությունների տարբերությունը` h(L)-h(R), կանվանենք տվյալ հանգույցի բանլանսավորվածության գործակից.
(defun balance-factor (tree)
  (- (tree-height (cadr tree))
     (tree-height (caddr tree))))
Այս գրառման համատեքստում կասենք, որ բինար որոնման ծառը բալանսավորված է, երբ նրա յուրաքանչյուր հանգույցի աջ ու ձախ ենթածառերի բարձրությունները տարբերվում են ամենաշատը մեկով՝ բալանսավորվածության գործակիցը -1, 0 կամ 1 է (տես. AVL ծառերbalanced-p պրեդիկատը ռեկուրսիվ եղանակով ստուգում է ամբողջ ծառի բալանսավորվածությունը․
(defun balanced-p (tree)
  (if (leaf-p tree)
      T
      (and (balanced-p (cadr tree)) 
    (balanced-p (caddr tree))
    (member (balance-factor tree) '(-1 0 1)))))
* * *
Գործողություններ։ Շատ հետաքրքիր գործողություն է բալանսավորված ծառում նոր արժեքի ավելացումը։ Դրա համար պետք է նախ որոնել և ավելացնել տրված արժեքը ծառում այնպես, ինչպես դա արվում է սովորական բինար որոնման ծառում։ Հետևյալ add-value ֆունկցիան բնար որոնման ծառում ավելացնում է նոր տերև՝ տրված արժեքով։
(defun add-value (tree val)
  (if tree
      (destructuring-bind (d l r)
          tree
        (cond ((< val d) (list d (add-value l val) r))
       ((> val d) (list d l (add-value r val)))
       (t tree)))
      (list val nil nil)))
Այնուհետև հետ գնալ որոնման ճանապարհով և ամեն մի հանգույցում ստուգել բալանսավորվածությունը։ Եթե այն խախտված է, ապա՝ վերականգնել։ Հայտնի է, որ հանգույցում կարող է հանդիպել բալանսավորվածության խախտման չորս դեպքերից որևէ մեկը (իրականում դեպքերը երկուսն են, իսկ մյուս երկուսը պարզապես սիմետրիկ տարբերակներ են)։ Տվյալների կառուցվածքներին նվիրված համարյա բոլոր գրքերում որտեղ պատմվում է AVL ծառերի մասին, այս չորս դեպքերը մանրամասնորեն նկարագրված են։ Ես պարզապես օրինակներով ցույց կտամ, թե ինչպես է ոչ բալանսավորված ծառը ձևափոխվում բալանսավորվածի։

Ստորև ներկայացված են ծառի A հանգույցում բալանսավորվածության խախտման չորս դեպքերը և այն գործողությունները, որոնց կատարումից հետո ծառը վերածվում է բալանսավորվածի։
G A F B E C D A գագաթը պտտել դեպի աջ։ G A F B E C D
G A F C E B D Պտտել B գագաթը դեպի ձախ, ապա A գագաթը՝ դեպի աջ։ G A F C E B D
G C F B E A D A գագաթը պտտել դեպի ձախ։ G C F B E A D
G B F C E A D Պտտել B գագաթը դեպի աջ, ապա A գագաթը՝ դեպի ձախ։ G B F C E A D
Դեպի աջ ու ձախ պտույտների գործողությունները ծրագրավորված են համապատասխանաբար rotate-right և rotate-left ֆունկցիաներով։
(defun rotate-right (tree)
  (destructuring-bind ((h l r) (lh ll lr)) 
      (list tree (cadr tree))
    (declare (ignore l))
    (list lh ll (list h lr r))))
(defun rotate-left (tree)
  (destructuring-bind ((h l r) (rh rl rr))
      (list tree (caddr tree))
    (declare (ignore r))
    (list rh (list h l rl) rr)))
Այս երկու ֆունկցիաների համադրմամբ պատրաստել եմ ևս երկու օգնական ֆունկցիաներ։ rotate-right-left ֆունկցիան դեպի աջ պտույտ է կատարում տրված ծառի աջ ենթածառում, ապա դեպի ձախ պտույտ է կատարում ծառի արմատում։ Իսկ rotate-left-right ֆունկցիան դեպի ձախ պտույտ է կատարում տրված ծառի ձախ ենթածառում, ապա դեպի աջ պտույտ է կատարում ծառի արմատում։
(defun rotate-right-left (tree)
  (destructuring-bind (h l r)
      tree
    (rotate-left (list h l (rotate-right r)))))
(defun rotate-left-right (tree)
  (destructuring-bind (h l r)
      tree
    (rotate-right (list h (rotate-left l) r))))
Հիմա պետք է ծրագրավորել մի ֆունկցիա, անվանենք այն add-value-to-avl, որը տրված ծառում կավելացնի տրված արժեքը և միաժամանակ կշտկի խախտված բալանսավորվածության դեպքերը։ Ձևափոխեմ քիչ վերևում բերված add-value ֆունկցիան այնպես, որ այն իր ձախ ու աջ ենթածառերում արժեքի ռեկուրսիվ ավելացման ժամանակ օգտագործի add-value-to-avl ֆունկցիան։ Թող այս նոր ֆունկցիան ստանա add-value-to-bst անունը։
(defun add-value-to-bst (tree val)
  (if tree
      (destructuring-bind (d l r)
          tree
        (cond ((< val d)
               (list d (add-value-to-avl l val) r))
              ((> val d)
               (list d l (add-value-to-avl r val)))
              (t tree)))
      (list val nil nil)))
Հիմնական add-value-to-avl ֆունկցիան տրված tree ծառում ավելացնում է տրված val արժեքը, ը նոր ստեղծված ծառը կապում է nw լեքսիկական փոփոխականին։ Այնուհետև հաշվում է nw ծառի բալանսավորվածության գործակիցը՝ bl։ Բալանսավորվածության խախտման չորս դեպքերը ստուգվում են cond կառուցվածքում, որի առաձին չորս ճյուղերի պայմանները ճշտորեն համընկնում են վերը բերված սխեմաների A գագաթում բալանսավորվածության խախտման դեպքերին։
(defun add-value-to-avl (tree val)
  (let* ((nw (add-value-to-bst tree val))
         (bl (balance-factor nw))
         (dl (caadr nw))
         (dr (caaddr nw)))
    (cond ((and (> bl 1) (< val dl))
            (rotate-right nw))
          ((and (> bl 1) (> val dl))
            (rotate-left-right nw))
          ((and (< bl -1) (< val dr))
            (rotate-right-left nw))
          ((and (< bl -1) (> val dr))
            (rotate-left nw))
          (t nw))))
Եվ վերջում մի մակրոս, որը հնարավորություն է տալիս մեկ տողով կառուցել AVL-ծառ՝ տրված արժեքներով։
(defmacro build-avl-tree (&body elems)
  (let ((result (gensym)))
    `(let ((,result '()))
       (dolist (e ',elems)
        (setf ,result (add-value-to-avl ,result e)))
       ,result)))
Առայժմ այսքանը Common Lisp լեզվով բալանսավորված բինար որոնման ծառերի իրականացման մասին։
* * *
Օգտագործված գրականություն։
  1. Guy Steele, Common LISP. The Language. Second Edition.
  2. Robert Sedgewick, Algorithms in Java, Parts 1-4 (3rd Edition).
  3. Robert Sedgewick, Kevin Wayne, Algorithms (4th Edition).
  4. Donald Knukth, Art of Computer Programming, Volume 3: Sorting and Searching (2nd Edition).
  5. Niklaus Wirth, Algorithms and Data Structures.
  6. Alfred Aho, Jeffrey Ullman, John Hopcroft, Data Structures and Algorithms.

Thursday, February 14, 2013

Նախապատվություններով հերթի իրականացումը

Հերթի այն տեսակը, որտեղ տարրերը կարող են ավելացվել կամայականորեն, բայց կարող են հեռացվել միայն ըստ նրանց մեջ սահմանված կարգի, կոչվում է նախապատվություններով հերթ։ Օրինակ, եթե որպես հերթի մեջ ավելացվող տարրեր դիտարկվում են թվերը, իսկ թվերի մեջ սահմանված կարգ է հանդիսանում "\(<\)" (փոքր է) գործողությունը, ապա ամեն անգամ հերթից որևէ տարր պահանջելով կստանանք այնտեղ եղած տարրերից ամենափոքրը (նույնը կարելի է ասել, իհարկե, "\(>\)" (մեծ է) գործողության նկատմամբ)։ Մեկ այլ օրինակում, եթե հերթի որպես տարրեր դիտարկվում են բառեր (տեքստ), իսկ որպես կարգի հարաբերությունը սահմանված է բառի երկարության նկատմամբ՝ \(|w_1| < |w_2|\), ապա ամեն անգամ հերթից տարր պահանջելով կստանանք այդ պահին հերթում մնացած ամենակարճ բառը։

Նախապատվություններով հերթն իրականացվում է մի տվյալների կառուցվածքի հիման վրա, որին գրականության մեջ տրված է heap (ռուս. куча) անունը։ Սա մի ծառ է (տվյալ դեպքում՝ բինար ծառ), որի ամեն մի հանգույցի արժեքն ավելի փոքր է (մեծ է) իր ժառանգների արժեքներից։ Բնականաբար ծառի արմատում գտնվում է ամենափոքր (կամ ամենամեծ) տարրը։ Այս ծառը նաև լրիվ (բինար) ծառ է։
Դասախոսությունների կամ այլ խոսակցությունների ժամանակ (քանի որ հայերեն գրականություն գործնականում չկա) ես հանդիպել եմ նաև heap տերմինի կույտ բառացի և, իմ կարծիքով, անհաջող թարգմանությանը։ Հանդիպել եմ նաև բուրգ տերմինը, և այս գրառման մեջ կօգտագործեմ հենց այս տարբերակը։
Ենթադրենք արդեն իրականացրել ենք Heap<T> շաբլոնային դասը որն ունի Add(T value) մեթոդը՝ հերթում տարրեր ավելացնելու համար, և T TakeMinimal() մեթոդը՝ հերթից ամենաբարձր նախապատվություն (տվյալ դեպքում՝ ամենափոքր արժեք) ունեցող տարրը հեռացնելու համար։ Ինչպես նաև նախատեսված է արժեքավորող ցուցակով կոնստրուկտոր։ Ստեղծենք int տիպի արժեքների հերթ և նրանում ավելացնենք {32, 9, 23, 14, 17, 2, 20, 17, 6} թվերը։
  Heap h {32, 9, 23, 14, 17, 2, 20, 17, 6};
Այս թվերով կառուցված ծառը կունենա ստորև բերված նկարի տեսքը, որում երևում է, որ ամեն մի հանգույցի արժեք ավելի փոքր է, քան իր ժառանգների արժեքները։
2 6 9 14 17 23 20 32 17
* * *
Հիմա ներկայացնեմ իրականացումը։ Սովորաբար բուրգն իրականացվում է ոչ թե ցուցիչների վրա հիմնված դինամիկ կառուցվածքների միջոցով, այլ սովորական ինդեքսավորված վեկտորներով։ Բուրգի արմատի արժեքը գրվում է վեկտորի զրո ինդեքսով բջջում։ Իսկ ամեն մի k ինդեքսով հանգույցի աջ (R) ու ձախ (L) ժառանգների ինդեքսները հաշվվում են L=2k+1 և R=2k+2 բանաձևերով։ Օրինակ, նկարում բերված ծառը վեկտորի տեսքով կներկայանա հետևյալ կերպ.
 Value | 2 | 6 | 9 | 14| 17| 23| 20| 32| 17
-------+---+---+---+---+---+---+---+---+---
 Index | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8
Այս ներկայացումն արդյունավետ է շնորհիվ այն բանի, որ բուրգը լրիվ ծառ է և ամենաներքևի մակարդակը լրացված է ձախից աջ։
Եվ այսպես, C++11 լեզվով սահմանում եմ Heap դասը։ Այս դասի size ստատիկ հաստատունը ցույց է տալիս տարրերի վեկտորի նախնական չափը։ capacity դաշտը ցույց է տալիս բուրգի տարողությունը, իսկ count դաշտը ցույց է տալիս տվյալ պահին առկա տարրերի քանակը։ Տարրերը պահվում են դինամիկ ստեղծվող data զանգվածում։
template
class Heap {
protected:
  static const int size = 32;

  unsigned int capacity;
  unsigned int count;
  T* data;
Դասի կոնստրուկտորներից մեկը պարզապես ստեղծում է դատարկ օբյեկտ, իսկ մյուսը բուրգի մեջ է ավելացնում արժեքավորող ցուցակով տրված տարրերը։ Իսկ դեստրուկտորը պարզապես ազատում է տարրերի զանգվածի զբաղեցրած հիշողությունը։
public:
  Heap()
    : capacity(size), count(0)
  {
    data = new T[capacity];
  }
  
  Heap( std::initializer_list<T> elems )
    : Heap()
  {
    for( auto e : elems )
      Add( e );
  }
    
  virtual ~Heap()
  {
    delete[] data;
  }
Նախապատվություններով հերթում նոր տարր ավելացնելիս նախ այն ավելացվում է զանգված վերջում, ապա, heapify գործողության կիրառմամբ զանգվածի տարրերը վերադասավորվում են այնպես, որ շարունակեն բավարարել բուրգի վերը նշված պահանջներին։ Եթե հերթական տարրն ավելացնելուց հետո պարզվում է, որ զանգվածի տեղերը սպառվել են (count == capacity), ապա զանգվածի երկարությունը կրկնապատկվում է։
  void Add( T val )
  {
    data[count] = val;
    ++count;
    heapify();
    if( count == capacity )
      enlarge();
  }
heapify գործողության ժամանակ տարրը տեղաշարժվում է դեպի ձախ այնքան ժամանակ, քանի դեռ այն փոքր է ծնոսի արժեքից։ Ի դեպ, տրված k ինդեքսով տարրի ծնողի ինդեքսը որոշվում է (k - 1)/2 բանաձևով։
  void heapify()
  {
    unsigned int i(count - 1);
    unsigned int k((i - 1) / 2);
    while( i > 0 && data[i] < data[k] ) {
      auto temp(data[i]);
      data[i] = data[k];
      data[k] = temp;
      i = k;
      k = (i - 1) / 2;
    }
  }
Զանգվածն ընդլայնող enlarge մեթոդը համակարգից պահանջում է գոյություն ունեցողից երկու անգամ մեծ հիշողություն, տարրերն արտագրում է այդ նոր տիրույթում և համակարգին է վերադարձնում հին տարածքը։
  void enlarge()
  {
    T* temp(data);
    capacity *= 2;
    data = new T[capacity];
    for( unsigned int i = 0; i < count; ++i )
      data[i] = temp[i];
    delete[] temp;
  }
Նախապատվություններով հերթից ամենաբարձր նախապատվություն ունեցող տարրը հեռացնելու համար գրված է TakeMinimal մեթոդը։ Այն հեռացնում է բուրգի գագաթի տարրը, ապա մյուս տարրերը վերադասավորում է այնպես, որ նրանք շարունակեն բավարարել բուրգի պայմաններին և վերադարձնում է հեռացված արժեքը։ Այս մեթոդում վերադասավորման համար օգտագործված է heapify մեթոդը։ Բայց գաղափարն այն է, որ ամենաներքևի մակարդակի ամենաաջ տարրը տեղափոխվում է բուրգի գագաթը, ապա այն փոխատեղվում է իր ժառանգներից ամենափոքրի հետ այնքան ժամանակ, քանի դեռ չի հասել իր իսկական տեղին։
  T TakeMinimal()
  {
    auto result(data[0]);
    data[0] = data[--count];
    heapify();
    if( count * 2 == capacity )
      reduce();
    return result;
  }
TakeMinimal մեթոդով որևէ տարր հեռացնելուց հետո ստգուգվում է տարրերի զանգվածի վիճակը։ Եթե զանգվածի տարողությունը երկու անգամ մեծ է տարրերի իրական քանակից՝ count * 2 == capacity, ապա զանգվածի չափը կրճատվում է երկու անգամ։ reduce մեթոդը ստեղծում է երկու անգամ փոքր տիրույթ, տարրերն արտագրում է նրա մեջ, ապա համակարգին է վերադարձնում ին մեծ տիրույթը։
  void reduce()
  {
    if( capacity > size ) {
      capacity /= 2;
      auto temp(data);
      data = new T[capacity];
      for( unsigned int i = 0; i < count; ++i )
        data[i] = temp[i];
      delete[] temp;
    }
  }
};
* * *
Առայժմ այսքանը նախապատվություններով հերթերի մասին։ Չնայած որ տեքստը մի քիչ կցկտուր ստացվեց, բայց, կարծում եմ, որ ընդհանուր առմամբ այն հասկանալի է։

Sunday, February 10, 2013

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]]
}

Friday, February 8, 2013

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)"
  }
}