Showing posts with label Լիսպ. Show all posts
Showing posts with label Լիսպ. Show all posts

Tuesday, November 19, 2019

Էսսե տեղադրությունների մասին

— Ուսուցի՛չ,— ասաց Ուաո Գոն,— ինչպե՞ս կարելի է գեներացնել տողի բոլոր տեղադրությունները (permutations):

Կոնֆուցիոսը մի քիչ մտածեց ու հիշեց, որ այդ մասին կարդացել է Կնուտի «Ծրագրավորման արվեսստը» գրքի չորրորդ հատորում (Donald Knuth, «The Art of Computer Programming», vol. 4A)։ Այդ գրքի 7.2.1.2 Generating all permutations բաժնում պատմվում է տեղադրությունները գեներացնելու զանազան ալգորիթմների մասին. ինչպես միշտ՝ Կնուտն իր բարձունքի վրա է։

— Չգիտեմ։ Կարդացեք դասականներին,— ասաց Կոնֆուցիոսը մի քիչ էլ մտածելուց հետո։

* * *

Հաջորդ օրը Կոնֆուցիոսը տաճար մտավ ու տեսավ Ուաո Գոին աղոթելիս։ Կանչեց նրան իր սեղանի մոտ ու ցույց տվեց տախտակների վրա գրված այս տեքստը.

(defun insert-at (e l i)
    (if (zerop i)
        (cons e l)
        (cons (car l) (insert-at e (cdr l) (1- i)))))

(defun range (e r)
    (if (= 0 e)
        (cons 0 r)
        (range (1- e) (cons e r))))
(defun insert-at-all (e l)
    (mapcar #'(lambda (i) (insert-at e l i))
        (range (length l) '())))

(defun insert-to-all-items (e ls)
    (apply #'append (mapcar #'(lambda (q) (insert-at-all e q)) ls)))

(defun permutations-of (l)
    (if (null (cdr l))
        (list l)
        (insert-to-all-items (car l) (permutations-of (cdr l)))))

— Ի՞նչ է սա, ուսուցի՛չ,— հարցրեց Ուաո Գոն։

— permutations-of-string-ը գեներացնում է տրված տողի բոլոր տեղադրությունները։

— Ինչպե՞ս։

— Տե՛ս։ Մի որևէ հաջորդականության բոլոր տեղադրությունները ստանալու համար կարելի է առանձնացնել դրա տարրերից մեկը, օրինակ առաջինը, ապա, ռեկուրսիվ եղանակով, հաշվել մյուս տարրերի հաջորդականության բոլոր տեղադրությունները և վերջում առանձնացված տարրը «խցկել» կառուցված տեղադրությունների բոլոր հնարավոր դիրքերում՝ ամեն մի «խցկելու» գործողությամբ գեներացնելով նոր տեղադրություն։ Պա՞րզ է։

— Լավ կլիներ օրինակ բերեիք, ուսուցի՛չ։

— Լավ։ Վերցնենք {a, b, c}։ Առաձնացնենք դրա առաջին տարրը՝ a-ն, մնացած տարրերի հաջորդականությունը կլինի {b, c}: Այս վերջինիս բոլոր հնարավոր տեղադրություններն են.

{(b, c), (c, b)}

Հիմա առանձնացված a տարրը տեղադրենք այս բազմության բոլոր տարրերի բոլոր դիրքերում։ (b, c)-ի համար կստանանք.

(a, b, c), (b, a, c), (b, c, a)

իսկ (c, b)-ի համար էլ.

(a, c, b), (c, a, b), (c, b, a)

Ահա սրանց միավորումն էլ հենց {a, b, c} հաջորդականության բոլոր տեղադրություններն են.

{(a, b, c), (b, a, c), (b, c, a), (a, c, b), (c, a, b), (c, b, a)}

— Ուսուցի՛չ, ո՞րն է ռեկուրսիայի տարրական դեպքը։

— Դա միայն մեկ տարր ունեցող հաջորդականությունն է։ Օրինակ, {a}-ի բոլոր տեղադրությունների բազմությունն է. {(a)}։

— Իսկ ի՞նչ հեզվով են գրված ձեր տախտակները, ուսուցի՛չ։

— Օ՜, դա Լիսպն է, լեզուների մեջ վեհագույնը։

— Թույլ տվեք մի անգամ էլ նայել տախտակներին,— խնդրեց Ուաո Գոն։

— Ահա՛։

— Թարգմանեք, խնդրում եմ, շատ հետաքրքիր է։

— Լավ։ Սկսենք առաջին տախտակից՝ ամենապարզից։ Ինչպես տեսար, տեղադրություններ կառուցելու տարրական գործողությունը տրված հաորդականության տրված դիրքում մի որևէ տարր խցկելն է։ Օրինակ, եթե հաջորդականությունն ունի երեք տարր՝ abc, ապա գոյություն ունեն նոր տարրը խցկելու 4 հնարավոր դիրքեր՝ ₀a₁b₂c₃։ insert-at գործողությունը e տարրը տեղադրում է l ցուցակի i-րդ դիրքում։

(defun insert-at (e l i)
    (if (zerop i)
        (cons e l)
        (cons (car l) (insert-at e (cdr l) (1- i)))))

Հաջորդ տախտակի վրա գրված insert-at-all գործողությունը e տարրը խցկում է l ցուցակի բոլոր թույլատրելի դիրքերում (դրանք |l|+1 հատ են), և վերադարձնում է խցկելու յուրաքանչյուր գործողությունից «ծնված» ցուցակների ցուցակը։ range օժանդակ ֆունկցիան պարզապես կառուցում է տարրը տեղադրելու ինդեքսների ցուցակը։

(defun range (e r)
    (if (= 0 e)
        (cons 0 r)
        (range (1- e) (cons e r))))
(defun insert-at-all (e l)
    (mapcar #'(lambda (i) (insert-at e l i))
        (range (length l) '())))

Երրորդ տախտակի insert-to-all-items գործողությունը insert-at-all ֆունկցիան կիրառում է ls ցուցակի բոլոր տարրերի նկատմամբ, և այդ կիրառություններից ստացված բոլոր ցուցակները միավորում է մի ընդհանուրի մեջ։

(defun insert-to-all-items (e ls)
    (apply #'append (mapcar #'(lambda (q) (insert-at-all e q)) ls)))

Դե, իսկ չորրորդ տախտակին գրված permutations-of գործողությունը հենց խնդրի բուն լուծումն է՝ ռեկուրսիայի կազմակերպմամբ։ Եթե տրված l ցուցակը միայն մի տարր ունի, ապա պատասխանը հենց այդ ցուցակը պարունակող ցուցակն է։ Ռեկուրսիայի քայլում կառուցվում է ցուցակի պոչի տեղադրությունների բազմությունը, ապա՝ insert-to-all-items նախնական ցուցակի առաջին տարրը ավելացվում է բոլոր այդ տեղադրություններին։

(defun permutations-of (l)
    (if (null (cdr l))
        (list l)
        (insert-to-all-items (car l) (permutations-of (cdr l)))))

— Իսկ ինչպե՞ս ենք կառուցելու _տողի_ բոլոր տեղադրությունների բազմությունը, ուսուցի՛չ։

— Դրա համար պետք է տողից կառուցենք նրա տառերի ցուցակը, կառուցենք այդ ցուցակի բոլոր տեղադրությունների բազմությունը, ապա ամեն մի տեղադրությունից ստանանք նոր տող։ Տո՛ւր ինձ մի մաքուր տախտակ։

Կոնֆուցիոսը վերցրեց Ուաո Գոի մեկնած տախտակն ու դրա վրա գրեց.

(defun permutations-of-string (s)
    (mapcar #'(lambda (e) (format nil "~(~{~C~}~)" e))
            (permutations-of (coerce s 'list))))

— Հիմա, Ուաո Գո՛, գնա ու շարունակիր աղոթքդ,— ասաց Կոնֆուցիոսը։

Ուաո Գոն խոնարհվեց ուսոցչին ու խնդրեց.

— Թույլ տուր մի անգամ էլ նայեմ տախտակներին։

Tuesday, December 19, 2017

Երեք պատահական խնդիր

Արտահայտության հապավում

Խնդիրը։ Տրված է ինչ-որ արտահայտություն, օրինակ, «Միացյալ ազգերի կազմակերպություն» և պահանջվում է սրանից ստանալ «ՄԱԿ» հապավումը։

Դպրոցականը կամ ուսանողը, հավանաբար, առաջին լուծումը կտանի այսպես. տողը դարձնել ցուցակ, հետո անցնել տողի վրայով ու հավաքել բոլոր այն տառերը, որոնց նախորդում են տառ չհանդիսացող այլ սիմվոլներ։ Հետո՝ հավաքած տառերը դարձնել մեծատառ ու միավորել մեկ տողի մեջ։

Տողից նիշերի ցուցակ ստացվում է coerce ֆունկցիայով.

(coerce "abcd" 'list)    ; => (#\a #\b #\c #\d)
Նույն coerce ֆունկցիայով նիշերի ցուցակից ստացվում է տող.
(coerce '(#\a #\b #\c #\d) 'string)    ; => "abcd"

Նիշերի ցուցակից բառերի առաջին տառերն ընտրող ֆունկցիան կարելի է գրել ռեկուրսիվ եղանակով։

(defun select-first-letters (sl)
    (if (endp sl)
        '()
        (if (and (not (alpha-char-p (car sl))) (alpha-char-p (cadr sl)))
            (cons (cadr sl) (select-first-letters (cddr sl)))
            (select-first-letters (cdr sl)))))

Դե իսկ հապավում կառուցող ֆունկցիան արդեն կարելի է կառուցել այսպես․

(defun acronym-of (s)
    (string-upcase (coerce (select-first-letters (coerce s 'list)) 'string)))
Բայց այս ֆունկցիան ճիշտ չի աշխատելու, որովհետև տողի առաջին տառը, որը պետք է լինի հապավման առաջին տառը, չի բավարարում select-first-letters ֆունկցիայի 4֊րդ տողում գրված պայմանին։ Այդ թերությունը շտկելու համար պետք է պարզապես տողը նիշերի ցուցակ դարձնելուց հետո դրա սկզբից կցել մի որևէ նիշ։ Այսինքն acronym-of ֆունկցիան սահմանել հետևյալ կերպ․
(defun acronym-of (s)
    (string-upcase (coerce (select-first-letters (cons #\Space (coerce s 'list)) 'string))))
Սրա հետևանքով select-first-letters ֆունկցիայի երկրերդ տողում գրված պայմանը կձևափոխվի․
(defun select-first-letters (sl)
    (if (or (endp sl) (endp (cdr sl)))
        '()
        (if (and (not (alpha-char-p (car sl))) (alpha-char-p (cadr sl)))
            (cons (cadr sl) (select-first-letters (cddr sl)))
            (select-first-letters (cdr sl)))))

* * *

Փորձառու ծրագրավորողն այսպիսի բան, իհարկե, չի գրի։ Նա միանգամից կնկատի, որ արտահայտության հապավումը կառուցելու համար բավական է մեծատառ դարձնել բառերի միայն առաջին տառերը, իսկ մնացածները թողնել փոքրատառ։ Հետո դեն գցել ամեն ինչ՝ բացի մեծատառերից։

(defun acronym (text)
    (remove-if-not #'upper-case-p (string-capitalize text)))
Սա Արդեն ֆունկցիոնալ լուծում է։ string-capitalize ֆունկցիան վերադարձնում է տողը՝ որում բառերի միայն առաջին տառերն են մեծատառ։ remove-if-not ֆունկցիան ֆիլտրող ֆունկցիա է. այն իր երկրորդ արգումենտում տրված հաջորդականությունից դեն է գցում իր առաջին արգումենտում տրված պրեդիկատին չբավարարող տարրերը։

* * *

Տիպիկ C-ական լուծումն էլ այսպիսին կլինի.

void acronym(const char *text, char *acr)
{
    *acr++ = toupper(*text++);
    while( *text != '\0' ) {
        if( isalpha(*text) && !isalpha(*(text-1)) )
            *acr++ = toupper(*text);
        ++text;
    }
    *acr = '\0';
}


 

Բառերի հեմինգյան հեռավորություն

Խնդիրը։ Երկու նույն երկորությունն ունեցող բառերի հեմինգյան հեռավորություն է կոչվում դրանց նույն դիրքերում տարբերվող տառերի քանակը։ Օրինակ, abc և abc բառերի հեմինգյան հեռավորությունը զրո է, իսկ abc և aec բառերի հեմինգյան հեռավորությունը մեկ է, և այլն։

Իտերատիվ լուծումը կարող է լինել loop մակրոսի օգտագործմամբ։ Երկու զուգահեռ հաշվիչներ անցնում են տողերի վրայով և համեմատում են նույն դիրքում գտնվող տառերը։ Եթե դրանք տարբեր են, ապա հաշվարկման արդյունքին գումարվում է մեկ։

(defun hamming-distance (so si)
    (loop for x across so
          for y across si
          when (char-not-equal x y)
          sum 1))

Ֆունկցիոնալ լուծման առաջին մոտարկումը կարող է լինել այսպես. map ֆունկցիայով տրված բառերից կառուցվում է մի ցուցակ, որի i-րդ դիրքում գրված է 0` եթե բառերի i-րդ դիրքերի տառերը հավասար են, և 1՝ հակառակ դեպքում։ Այնուհետև apply ֆունկցիայով + գործողությունը կիրառվում է այդ ցուցակի նկատմամբ՝ վերադարձնելով տարբերվող տառերի քանակը։

(defun hamming-distance (so si)
    (apply #'+ (map 'list #'(lambda (x y) (if (char-equal x y) 0 1))
           so si)))

Վերջնական ֆունկցիոնալ լուծումն ավելի լավն է. նույն map ֆունկցիայով ստեղծվում է char-not-equal ֆունկցիայի արդյունքների ցուցակ՝ կազմված t-երից և nil-երից։ Իսկ հետո count ֆունցիայով հաշվվում է t-երի քանակը, որն էլ հենց տրված բառերի հեմինգյան հեռավորությունն է։

(defun hamming-distance (so si)
    (count t (map 'list #'char-not-equal so si)))

* * *

C-ական իրականացումը պարզապես հաշվում է բառերի նույն դիրքում տարբերվող տառերի քանակը.

unsigned int hamming_distance(const char *so, const char *si)
{
    unsigned int dist = 0;
    while( *so != '\0' && *si != '\0' )
        if( *so++ != *si++ )
            ++dist;
            
    return dist;
}


 

Ենթացուցակի ստուգում

Խնդիրը։ Ստուգել, թե արդյոք s0 ցուցակը s1 ցուցակի ենթացուցակն է։ Օրինակ, [3, 4, 5] ցուցակը [1, 2, 3, 4, 5, 6] ցուցակի ենթացուցակ է։

Միանգամից «ֆունկցիոնալ» լուծումը. s0-ն s1-ի ենթացուցակ է, եթե կա՛մ s0-ն համընկնում է s1-ի սկիզբի հետ՝ նրա պրեֆիքսն է, կա՛մ s0-ն s1-ի պոչի ենթացուցակն է։

Common Lisp լեզվով գրառումը.

(defun is-sublist (so si)
    (or (is-prefix so si)
        (is-sublist so (cdr si))))

is-prefix ֆունկցիայի իրականացումն էլ շատ հետաքրքիր է.

(defun is-prefix (so si)
    (not (member nil (mapcar #'eq so si))))
mapcar ֆունկցիայով կառուցվում է երկու ցուցակների համապատասխան տարրերի՝ իրար հավասար լինելու (կամ չլինելու) ցուցակը։ member ֆունկցիայով այդ ցուցակում որոնվում է որևէ nil արժեք, իսկ not ֆունկցիայով էլ պահանջվում է, որ nil չլինի։

C լեզվով պրեֆիքսի և ենթացուցակի ստուգման ֆունկցիաները կունենան հետևյալ ոչ պակաս հետաքրքիր տեսքը.

Եթե, օրինակ, ցուցակի հանգույցը սահմանված է այսպես.

struct node {
    char data;
    struct node *next; 
};

ապա s ցուցակի՝ l ցուցակի պրեֆիքս լինելը կաստուգվի այսպես.

bool is_prefix(const struct node *s, const struct node *l)
{
    while( NULL != s && NULL != l && s->data == l->data ) {
        s = s->next;
        l = l->next;
    }
    
    return NULL == s;
}

իսկ s ցուցակի՝ l ցուցակի ենթացուցակ լինելն էլ այսպես.

bool is_sublist(const struct node *s, const struct node *l)
{
    if( NULL == s )
        return true;

    if( NULL == l )
        return false;

    return is_prefix(s, l) || is_sublist(s, l->next);
}

Saturday, March 12, 2016

Գրքեր Lisp լեզվի մասին

Վերջին մի քանի տարիներին ես ակտիվորեն ուսումնասիրում եմ Lisp լեզուն, հատկապես նրա Common Lisp և Scheme տարատեսակները։ Եվ այդ ժամանակի ընթացքում հասցրել եմ ուսումնասիրել ավելի քան հարյուր գրքեր ու հոդվածներ՝ սկսած John McCarthy֊ի առաջին հոդվածից, վերջացրած Common Lisp֊ի ստանդարտով ու արհեստական բանականության մասին մենագրություններով։ Սակայն ես ուզում եմ այդ գրքերից առանձնացնել քանիսը, որոնք հատկապես կարևոր են Lisp լեզվի ուսումնասիրությունը սկսելու համար։

1. Practical Common Lisp, Peter Seibel ― հրաշալի գիրք է, գրված կենդանի լեզվով, առանց ավելորդ ճոռոմաբանությունների։ Բավականին շատ օրինակներով, որոնք բացահայտում են լեզվի բազմաթիվ հնարավարությունները և դրանց կիրառման առանձնահատկությունները։ Ազատ հասանելի է։ Մի քանի տարի առաջ թարգմանվել է նաև ռուսերեն՝ Практическое использование Common Lisp վերնագրով։

2. ANSI Common Lisp, Paul Graham ― Գրքի նախաբանում ասվում է, որ այն նախատեսված է Լիսպ լեզուն արագ ու հիմնավոր սովորելու համար։ Գրքի առաջին մասում մանրամասնորեն նկարագրվում են Լիսպ լեզվի հնարավորությունները, իսկ երկրորդ մասում՝ թվարկված և համառոտ նկարագրված է Common Lisp ստանդարտը։ Հեղինակը ՏՏ աշխարհի թերևս ամենահաջողակ մարդկանցից մեկն է։ Գիրքը նույն վերնագրով թարգմանված է ռուսերեն։

3. Common Lisp: the Language, 2nd ed., Guy Steel Jr. ― Այս գիրքը հենց Common Lisp ստանդարտն է։ Դրա ավելի քան 1000 էջերում մանրամասնորեն ու սպառիչ նկարագրված է լեզվի յուրաքանչյուր բաղադրիչ։ Լիսպ լեզվով աշխատելիս շատ օգտակար է մշտապես ձեռքի տակ ունենալ այս գիրքը։ Թարգմանված է ռուսերեն, սակայն հրատարակված չէ թղթի տարբերակով։ Common lisp: the Language գրքի և Common Lisp ստանդարտի հիման վրա պատրաստված է Common Lisp HyperSpec֊ը

4. Land of Lisp, Conrad Barski ― գծանկարներով ու ծաղրանկարներով հարուստ այս գրքում տարատեսակ խաղեր ծրագրավորելու օգնությամբ ու բավականին սրամիտ լեզվով պատմվում է Common Lisp լեզվի մասին։ Շատ հետաքրքիր գիրք է, հատկապես սկսնակների համար։

5. Common Lisp Recipes, Edmund Weitz ― Նոր եմ գտել այս գիրքը, դեռ չեմ հասցրել կարդալ։ Բայց բովանդակության մեջ քննարկված թեմաներից երևում է, որ շատ օգտակար ու հետաքրքիր նյութ է պարունակում։

Սկսելու համար թերևս այսքանը։

Sunday, January 10, 2016

GNU/Emacs֊ի փոքր ընդլայնում

Հայերեն տեքստերը OCR գործիքներով ճանաչելիս բավականին հաճախ է պատահում, որ բառի մեջ հայտնվում են անցանկալի բացատանիշեր։ Դա կապված է, օրինակ հայերեն տառերի պատկերների հետ, երբ տառի ձախ ու աջ կողմերից կան ցցված մասեր։

Երբ մաքրագրում եմ այդպիսի «ցանցառ» տեքստերը, ժամանակիս մեծ մասը ծախսվում է բացատները հեռացնելու վրա։ Հենց այդ պատճառով էլ որոշեցի GNU/Emacs֊ի համար (քանի որ այդ խմբագրիչն եմ առավել հաճախ օգտագործում) գրել մի օժանդակ ֆունկցիա, որը կհեռացնի տեքստնի նշված հատվածի՝ ռեգիոնի բացատները։

Ես պետք է կատարեի հետևյալ քայլերը․ i) վերցնել նշված տեքստը, ii) տեքստից հեռացնել բացատները, iii) հեռացնել հին տեքստը և iv) տեղադրել հեռացված բացատներով տեքստը։ Այս քայլերը պետք է ծրագրավորել որպես Emacs Lisp լեզվի ֆունկցիա, և կապել ստեղնների ինչ֊որ համակցության հետ, որպեսզի հնարավոր լինի այն օգտագործել տեքստի խմբագրման ինտերակտիվ ռեժիմում։

Բնականաբար, գործը սկսվեց ինտերնետում փորփրելուց՝ վերը նշված քայլերը կատարող գործողություների որոնմամբ։ Եվ այսպես․ i) Emacs֊ի բուֆերից՝ խմբագրվող տեքստի տիրույթից տեքստի հատվածը կարելի է վերցնել buffer-substring և buffer-substring-no-properties ֆունկցիաներով։ Սրանցից առաջիննը տեքստը տալիս է ինչ֊որ ատրիբուտների հետ, իսկ երկրորդը՝ առանց ատրիբուտների: ինձ պետք է երկրորդը։ ii) Տեքստը ֆիլտրելու համար նախ պետք է string-to-list ֆունկցիայով նրանից ստանալ ցուցակ, ապա այդ ցուցակից remq ֆունկցիայով հեռացնել ոչ պետքական տարրերը, վերջում էլ ցուցակից նորից ստանալ տող։ iii) Ռեգիոնը բուֆերից հեռացվում է delete-region ֆունկցիայով։ iv) Բուֆերի ընթացիկ կետում (point) տեքստը տեղադրվում է insert ֆունկցիայով։

Իմ գրած remove-region-spaces ֆունկցիան ունի երկու պարամետր՝ նշված տեքստի սկիզբն ու վերջը ցույց տվող ինդեքսները։ Ֆունկցիայի առաջին տողում գրված (interactive "r") արտահայտությունը պահանջում է, որ խմբագրման ինտերակտիվ ռեժիմում այս ֆունկցիան կանչելիս նրան փոխանվեն ռեգիոնի սկիզբն ու վերջը (ավելի ճիշտ՝ mark֊ը և point֊ը)։

(defun remove-region-spaces (begin end)
  (interactive "r")
  (let ((text (buffer-substring-no-properties begin end)))
    (delete-region begin end)
    (insert (apply #'string (remq ?\  (string-to-list text))))))

GNU/Emacs֊ում ստեղնների C-x C-j համադրությունն ազատ է։ remove-region-spaces ֆունկցիան կապում եմ այդ ստեղնների հետ՝ և՛ լատինական և հայերեն տառերի համար։

(global-set-key (kbd "C-x C-j") 'remove-region-spaces)
(global-set-key (kbd "C-ղ C-յ") 'remove-region-spaces)

Այսքանը։ remove-region-spaces ֆունկցիան և այն ստեղնների համադրության հետ կապող արտահայտությունները գրում եմ .emacs ֆայլում, և վերագործարկում եմ խմբագրիչը։

Monday, March 16, 2015

Common Lisp։ Պրոցեդուրային ծրագրավորման մասին

Մի անգամ Կոնֆուցիուսին հարցրեցին.
«Ուսուցիչ, ի՞նչ կարծիքի եք այն մասին, որ Ցզի-Սյուն ծրագրավորում է Lisp լեզվով։»
ՈՒսուցիչը մտածեց և ասաց.
«Ցզին խելացի է։ Նա կարող է գրել Lisp լեզվով։»
Lisp լեզուն մեզ ծանոթ է առավելապես որպես ֆունկցիոնալ ծրագրավորման լեզու։ Բայց ես ուզում եմ այս հոդվածում ներկայացնել Common Lisp լեզվի այն հնարավորությունները, որոնք թույլ են տալիս ծրագրավորել իմպերատիվ ոճով։ Հայտնի է, որ իմպերատիվ եղանակով ցանկացած ալգորիթմ ծրագրավորելու համար պետք են ամենաքիչը չորս ղեկավարող կառուցվածքներ՝ ա) վերագրման հրաման, բ) ճյուղավորման կամ պայմանի հրաման, գ) ցիկլի կամ կրկնման հրաման և դ) հրամանների հաջորդում։ Օրինակ, C++ լեզվում վերագրման հրամանն իրականացվում է «=» սիմվոլով ձևավորվող արտահայտությունների միջոցով, ճյուղավորումները կազմակերպվում են if կամ switch կառուցվածքներով, կրկնությունները կազմակերպվում են for, while և do կառուցվածքներով, իսկ հրամանների հաջորդումը որոշվում է ծրագրի տեքստում նրանց հանդիպելու հերթականությամբ։ Իհարկե, ծրագրերի հարմար կազմակերպման համար պետք է ունենալ ենթածրագրի սահմանման մեխանիզմ, ներածման ու արտածման գործողություններ և այլն։

Սկսենք վերագրման հրամանից։ Common Lisp լեզվում վերագրումները կատարվում են setq հատուկ կառուցվածքով և setf մակրոսով։ Օրինակ, *var-i* դինամիկ փոփոխականին 123 արժեքը կարող ենք վերագրել (setq *var-i* 123) արտահայտությամբ։ Կամ, vec զանգվածի 3-րդ տարրին 3.14 արժեքը կարող ենք վերագրել (setf (aref vec 3) 3.14) արտահայտությամբ։ setq հատուկ կառուցվածքը (ինչպես նաև setf մակրոսը) հնարավորություն ունի կատարել նաև հաջորդական վերագրումներ։ Օրինակ, (setq x 1 y (1+ x) z (* 3 y)) արտահայտությունը համարժեք է (setq x 1), (setq (1+ x)) և (setq z (* 3 y)) արտահայտությունների հաջորդականությանը։ Եթե հարկավոր է կատարել զուգահեռ վերագրումներ, ապա կարող ենք օգտագործել psetq և psetf մակրոսները։ Զուգահեռ վերագրումների դեպքում, բնականաբար, հերթական վերագրման ժամանակ չի կարելի օգտագործել նախորդ վերագրումների արդյունքները։

Ճյուղավորումներ կազմակերպելու համար Common Lisp լեզուն տրմադրում է if հատուկ կառուցվածքը և when, unless, cond մակրոսները։ Ահա նրանց տեսքը.
(if ⟨condition⟩ ⟨then-form⟩ ⟨else-form⟩?)

(when ⟨condition⟩ ⟨form⟩*)

(unless ⟨condition⟩ ⟨form⟩*)

(cond (⟨condition-1⟩ ⟨form-1⟩) (⟨condition-2⟩ ⟨form-2⟩) ...)
Օրինակ, a և b թվերից մեծագույնը c փոփոխականին վերագրելու համար կարող ենք գրել հետևյալ արտահայտություններից որևէ մեկը․
(if (> a b) (setq c a) (setq c b))
կամ
(setq c (if (> a b) a b))
if կառուցվածքը հնարավորություն է տալիս պայմանի ստուգումից հետո կատարել երկու ճյուղերից որևէ մեկը։ Եթե ունենք միայն մեկ ճյուղ, ապա կարող ենք օգտագործել կա՛մ when, կա՛մ unless մակրոսը։ when մակրոսը կատարում է իր մարմինը, երբ պայմանը դրական է, իսկ unless մակրոսը՝ երբ պայմանը բացասական է։ Օրինակ, հետևյալ երկու արտահայտությունների կատարման դեպքում էլ կարտածվի նույն պատասխանը․
(when (> a b) t)
(unless (<= a b) t)
cond մակրոսը կիրառելի է այն ժամանակ, երբ պետք է ընտրություն կատարել երկուսից ավելի ճյուղերի միջև։ Այն իր արգումենտում ստանում է զույգեր, որոնցից առաջին տարրը պայմանն է, իսկ երկրորդը՝ գործողությունը։ Ճյուղավորումն ավարտվում է այն գործողության կատարմամբ, որին համապատասխան պայմանը առաջինն է հաշվարկվում որպես դրական արժեք։ Օրինակ, 0-ից 2 թվերի անուններն արտածելու, իսկ մյուս թվերի համար «more» բառն արտածելու համար կգրենք․
(setq d (parse-integer (read-line)))
(cond ((= d 0) (print "zero"))
      ((= d 1) (print "one"))
      ((= d 2) (print "two"))
      (t (print "more")))
Ցիկլերի կազմակերպման համար Common Lisp լեզուն ունի այնպիսի հնարավորություններ, որ ցանկացած այլ լեզու միայն կարող է նախանձել։ Դիտարկենք dotimes, dolist և loop մակրոսների որոշ հնարավորություններ։ dotimes մակորսը պարզագույն հաշվիչով ցիկլ է։ Օրինակ, 0-ից 100 միջակայքի 20 պատահական թվերի ցուցակ կառուցելու համար կարող ենք գրել․
(setq rnums '())
(dotimes (j 20)
  (push (random 100) rnums))
dolist մակրոսը նման է dotimes մակրոսին, բայց սա իտերացիա է կատարում ցուցակի տարրերով։ Օրինակ, նախորդ օրինակում կառուցված պատահական թվերի ցուցակի տարրերի գումարը կարող ենք հաշվել և արտածել հետևյալ կերպ․
(setq rsum 0)
(dolist (e rnums)
  (incf rsum e))
(print rsum)
loop մակրոսով կարելի է 20 պատահական թվերի ցուցակը կազմել ահա այսպես.
(setq rnums (loop repeat 20 collect (random 100)))
Իսկ rnums ցուցակի տարրերի գումարը կարելի է հաշվել հետևյալ արտահայտությամբ.
(print (loop for e in rnums summing e))
Պրոցեդուրային լեզուների while ցիկլը նույնպես կարելի է գրել loop մակրոսի օգնությամբ։ Օրինակ, 1-ից 20 թվերը հակառակ հաջորդականությամբ տպելու համար կարող ենք գրել.
(setq a 20)
(loop while (> a 0)
      do (print a)
         (incf a -1))
Հրամանների հաջորդման համար Common Lisp լեզվում առկա են progn հատուկ կառուցվածքը և prog1, prog2 մակրոսները։ progn կառուցվածքը հերթականորեն հաշվարկում է իր արգումենտները և վերադարձնում է դրանցից վերջինի արժեքը։ prog1 և prog2 մակրոսները համապատասխանաբար վերադարձնում են առաջին և երկրորդ արգումենտների արժեքները։ Սրանք ինչ-որ իմաստով նման են պրոցեդուրային լեզուներում բլոկների կազմակերպման մեխանիզզմներին (ինչպես օրինակ Pascal լեզվի begin-end բլոկները)։ Լեզվի շատ ֆունկցիաներ ու մակրոսներ ունեն ոչ բացահայտ progn, այսինքն կարելի է պարզապես իրար հետևից գրել արտահայտությունները՝ առանց progn կառուցվածքի օգտագործման։ Օրինակ, while և unless մակրոսների կիրառման դեպքում progn պետք չէ, իսկ if հատուկ կառուցվածքի մարմնում պետք է։

Գլոբալ ֆունկցիաները Common Lisp լեզվում սահմանվում են defun մակրոսով։ Այն ստանում է սահմանվող ֆունկցիայի անունը, պարամետրերի ցուցակը և ֆունկցիայի մարմինը։ Օրինակ, հետևյալ ֆունկցիան իրար է գումարում արգումենտում ստացած երկու թվերը․
(defun add-two-num (a b)
  (+ a b))
Ֆունկցիայի վերադարձրած արժեք է համարվում նրա մարմնում հաշվարկված վերջին արտահայտության արժեքը։ Եվ վերջապես որպես օրինակ դիտարկենք տրված վեկտորի ամենամեծ ու ամենափոքր տարրը որոշող ալգորիթմը։ C++ լեզվով այն կարող ենք գրել հետևյալ կերպ․
template
std::tuple min_and_max( std::vector vec )
{
  T mn(vec.at(0));
  T mx(vec.at(0));
  for( auto e : vec ) {
    if( mn > e ) mn = e;
    if( mx < e ) mx = e;
  }
  return std::make_tuple(mn, mx);
}
Սա մի ֆունկցիա է, որը արգումենտում ստանում է վեկտոր, և վերադարձնում է երկու թիվ՝ վեկտորի տարրերից ամենամեծն ու ամենափոքրը։ Հիմա տեսնենք, թե Common Lisp լեզվով ինչպես կարելի է ծրագրավորել այս նույն ալգորիթմը։ Շաբլոնների կարիքը չունենք, որովհետև Lisp-ը տիպերի դինամիկ ստուգմամբ լեզու է (թեև հայտարարությունների օգնությամբ կարող ենք կոմպիլյատորին հուշել փոփոխականի տիպը)։ min-and-max ֆունկցիան, տիպիկ պրոցեդուրային ոճով, կունենա մոտավորապես հետևյալ տեսքը․
(defun min-and-max (vec)
  (declare (type array vec))
  (let ((mn (aref vec 0))
        (mx (aref vec 1)))
    (loop for e across vec
     do
       (if (> mn e) (setf mn e))
       (if (< mx e) (setf mx e)))
    (values mn mx)))
Բայց․․․ բայց բարեբախտաբար Lisp լեզուն նախատեսված չէ այս ոճի կոպիտ ծրագրեր գրելու համար։ (Ես պատկերացնում եմ, որ եթե Lisp-ինտերպրետատորը կարողանար ծիծանել, ապա այն ինչպիսի քրքջոց կբարձրացներ այս ֆունկցիան կարդալու ժամանակ։)

Saturday, August 23, 2014

Խնդիրների լուծումներ Lisp լեզվով

Տարիներ առաջ, երբ ես սովորում էի ԵՊՀ-ի ԻԿՄ ֆակուլտետում, երկրորդ կամ երրորդ կուրսում անցնում էինք մի անհասկանալի առարկա։ Այդ առարկայի անվանումն էր «Ֆունկցիոնալ ծրագրավորման համակարգեր» (կամ «Ծրագրավորման ֆունկցիոնալ համակարգեր»)։ Դասախոսություններին պատմում էին ինչ-որ անհասկանալի ու ախմախ բաների մասին։ Բայց գործնական դասերը, որոնք ոչ մի կապ չունեին դասախոսությունների հետ, գոնե հետաքրքիր էին նրանով, որ խնդիրներ էինք լուծում Lisp լեզվով։ Խնդրագիրք ասած բանն, իհարկե, գոյություն չուներ․ դասախոսներն ունեին սովորական թղթերի վրա տպած մի ցուցակ, որից էլ դասերին վարժություններ էինք անում։

Ստորև բերված են այդ ցուցակի խնդիրներից մի մասի լուծումներ։ Որոշ խնդիրների պահանջներ միգուցե վատ են ձևակերպված, որոշներինը՝ ակնհայտ անհեթեթություն են։ Բայց սա այն է, ինչ որ կար...

Լրացում (12.մարտ.2016)։ Ինձ հայտնի դարձավ, որ ստորև բերված խնդիրների հավաքածուն ԵՊՀ ԻԿՄ ֆակուլտետում հրատարակվել (կապ պատրաստվում է հրատարակության) առանձին խնդրագրքի տեսքով։ Այս խնդիրների ձևակերպումների բոլոր հեղինակային իրավունքները պատկանում են այդ խնդրագրքի հեղինակին կամ հեղինակային խմբին։ Նույն այդ հեղինակները որևէ առնչություն չունեն խնդիրների հետ բերված լուծումների հետ։


Թվային ռեկուրսիա

4. Գրել տրված \(n\) թվի ֆակտորիալը հաշվարկող ծրագիր:

Հետևելով ֆակտորիալի սահմանմանը՝ \(n!=1\cdot 2\cdot\ldots\cdot n\), կգրենք հետևյալ ֆունկցիան։
(defun factorial (n)
  (if (= n 0)
      1
      (* n (factorial (1- n)))))
Բայց ավելի արդյունավետ կլինի գրել ֆակտորիալը հաշվող ֆունկցիայի tail recursive տարբերակը։ Հետևյալ factorial-b ֆունկցիայի մարմնում սահմանված է factorial-rec ֆունկցիան, որի երկրորդ արգումենտը նախատեսված է արդյունքը կուտակելու համար։
(defun factorial-b (n)
  (labels 
      ((factorial-rec (m r)
  (if (= m 1)
      r
      (factorial-rec (1- m) (* m r)))))
    (factorial-rec n 1)))
5. Գրել Ֆիբոնաչիի հաջորդականության N-րդ անդամը հաշվարկող ծրագիր:

Նորից հետևելով Ֆիբոնաչիի թվերի սահմանմանը, կարելի է սահմանել հետևյալ ֆունկցիան։
(defun fibonachi (N)
  (if (or (= N 0) (= N 1))
      1
      (+ (fibonachi (- N 1)) (fibonachi (- N 2)))))
Ֆիբոնաչիի թվերի համար էլ կարելի է սահմանել tail recursive ֆունկցիա։ Ահա այն․
(defun fibonacci-b (n)
  (labels
      ((fibonacci-rec (m a b)
  (if (< m 2)
      a
      (fibonacci-rec (- m 1) (+ a b) a))))
    (fibonacci-rec n 1 0)))
6. Գրել \(x\) բնական թիվը չգերազանցող զույգ թվերի գումարը:
(defun sum-of-evens (x)
  (cond 
    ((zerop x) 0)
    ((evenp x) (+ x (sum-of-evens (1- x))))
    (t (sum-of-evens (1- x)))))
(defun sum-of-evens-b (x)
  (labels
      ((sum-of-evens-rec (y s)
  (cond 
    ((zerop y) s)
    ((evenp y) (sum-of-evens-rec (1- y) (+ s y)))
    (t (sum-of-evens-rec (1- y) s)))))
    (sum-of-evens-rec x 0)))
7. Գրել \(x\) թվին չգերազանցող կենտ թվերի արտադրյալը:
(defun prod-of-odds (x)
  (cond ((= x 1) 1)
 ((oddp x) (* x (prod-of-odds (1- x))))
 (t (prod-of-odds (1- x)))))
(defun prod-of-odds-b (x)
  (labels
      ((prod-of-odds-rec (y p)
  (cond ((= y 1) p)
        ((oddp y) (prod-of-odds-rec (1- y) (* p y)))
        (t (prod-of-odds-rec (1- y) p)))))
    (prod-of-odds-rec x 1)))
8. Գրել \(x\) թվի կիսաֆակտորիալը հաշվող ֆունկցիա:
(defun semifactorial (x)
  (labels
      ((semifac-help (k)
  (if (< k 0)
      1
      (* (semifac-help (1- k)) (- x (* 2 k))))))
    (semifac-help (1- (ceiling x 2)))))
(defun semifactorial-b (x)
  (labels
      ((semifac-rec (k r)
  (if (< k 0)
      r
      (semifac-rec (1- k) (* r (- x (* 2 k)))))))
    (semifac-rec (1- (ceiling x 2)) 1)))
9. Lisp լեզվով սահմանել most-divisor ֆունկցիան. F(x)=x թվի ամենամեծ բաժանարարը, եթե \(x\ge0\), հակառակ դեպքում՝ \(0\):
(defun most-divisor (x)
  (labels
     ((most-div-help (a b)
        (cond
           ((zerop b) 1)
           ((zerop (rem a b)) b)
           (t (most-div-help a (1- b))))))
    (cond
       ((<= x 0) 0)
       ((< x 3) 1)
       ((evenp x) (/ x 2))
       (t (most-div-help x (1- x))))))
10. Lisp լեզվով սահմանել Էվիկլիդեսի ալգորիթմը:
(defun euclid(x y)
  (if (= y 0)
      x
    (euclid y (mod x y))))
11. Օգտվելով 1+ ֆունկցիայից Lisp-ով ծրագրավորել երկու տեղանի գումարման plus ֆունկցիան ամբողջ թվերի համար:
(defun plus (a b)
  (if (zerop b)
      a
      (plus (1+ a) (1- b))))
12. Օգտվելով + ֆունկցիայից, ծրագրավորել prod ֆունկցիան, ամբողջ թվերի համար:
(defun prod (x y)
  (labels
      ((prod-help (b r)
  (if (zerop b) 
      r
      (prod-help (1- b) (+ x r)))))
    (if (or (= y 0) (= x 0))
 0
 (prod-help y 0))))
13. Օգտվելով * ֆունկցիայից, ծրագրավորել աստիճան բարձրացնելու ex ֆունկցիան, ամբողջ թվերի համար:
(defun ex (x y)
  (if (zerop y)
      1
      (* x (ex x (1- y)))))
14. Սահմանել հետևյալ ֆունկցիան. \(F(x)=x!+(2x)!\), եթե \(x\ge0\), հակառակ դեպքում՝ \(0\):
(defun ex14 (x)
    (if (< x 0)
        0
        (+ (factorial x) (factorial (* 2 x)))))
15. Սահմանել հետևյալ ֆունկցիան. \(F(x)=x!+x^y\), եթե \(x\ge0\), հակառակ դեպքում՝ \(0\):
(defun ex15 (x y)
    (if (< x 0)
      0
      (+ (factorial x) (expt x y))))
16. Սահմանել հետևյալ ֆունկցիան. \(F(x,y)=(xy)!\), եթե \(x,y\ge0\), հակառակ դեպքում՝ \(0\):
(defun ex16 (x y)
    (if (or (< x 0) (< y 0))
        0
        (* (factorial x) (factorial y))))
17. Սահմանել հետևյալ ֆունկցիան. \(f(x)=\sum\limits_{i=0}^x i^2\), եթե \(x\ge0\), հակառակ դեպքում՝ \(0\):
(defun ex17 (x)
    (if (< x 0)
        0
        (+ (* x x) (ex17 (1- x)))))
18. Սահմանել հետևյալ ֆունկցիան. \(f(x)=\sum\limits_{i=0}^x (2i)!\), եթե \(x\ge0\), հակառակ դեպքում՝ \(0\):
(defun ex18 (x)
    (if (minusp x)
        0
        (+ (factorial (* 2 x)) (ex18 (1- x)))))
19. Սահմանել հետևյալ ֆունկցիան. \(f(x,y)=\sum\limits_{i=0}^y(xi)!\), եթե \(x,y\ge0\), հակառակ դեպքում՝ \(0\):
(defun ex19 (x y)
    (if (or (<= x 0) (<= y 0))
        0
        (+ (factorial (* x y)) (ex19 x (1- y)))))
20. Սահմանել հետևյալ ֆունկցիան. \(f(x,y)=\sum\limits_{i=0}^x i^y\), եթե \(x,y\ge0\), հակառակ դեպքում՝ \(0\):
(defun ex20 (x y)
    (if (minusp x)
        0
        (+ (expt x y) (ex20 (1- x) y))))
21. Սահմանել հետևյալ ֆունկցիան. \(f(x)=\sum\limits_{i=0}^x\sqrt{i}\), եթե \(x\ge0\), հակառակ դեպքում՝ \(0\):
(defun ex21 (x)
    (if (< x 0)
        0
        (+ (sqrt x) (ex21 (1- x)))))
22. Սահմանել հետևյալ ֆունկցիան. \(f(x)=\prod\limits_{i=0}^xe^i\), եթե \(x\ge0\), հակառակ դեպքում՝ \(0\):
(defun ex22 (x)
    (if (<= x 0)
        1
        (* (exp x) (ex22 (1- x)))))
23. Սահմանել հետևյալ ֆունկցիան. \(f(x,y)=\prod\limits_{i=0}^y(x^i+i)\), եթե \(x,y\ge0\), հակառակ դեպքում՝ \(0\):
(defun ex23 (x y)
    (if (< y 0)
        1
        (* (+ (expt x y) y) (ex23 x (1- y)))))
24. Սահմանել հետևյալ ֆունկցիան. \(f(x,y,z)=\prod\limits_{i=0}^z(x^i+y^i)\), եթե \(x,y,z\ge0\), հակառակ դեպքում՝ \(0\):
(defun ex24 (x y z)
    (if (< z 0)
        1
        (* (+ (expt x z) (expt y z)) (ex24 x y (1- z)))))
25. Սահմանել հետևյալ ֆունկցիան. \(f(x,y,z)=\prod\limits_{i=0}^z(i^x+i^y)\), եթե \(x,y,z\ge0\), հակառակ դեպքում՝ \(0\):
(defun ex25 (x y z)
    (if (< z 0)
        1
        (* (+ (expt z x) (expt z y)) (ex25 x y (1- z)))))
26. Սահմանել հետևյալ ֆունկցիան. \(f(x,y)=\sum\limits_{i=0}^y\log_yx\), եթե \(x,y\ge0\), հակառակ դեպքում՝ \(0\):
(defun ex26 (x y)
    (if (<= y 1)
        0
        (+ (log x y) (ex26 x (1- y)))))
27. Սահմանել ֆունկցիա, որը վերադարձնում է տրված \(x\) թվի բաժանարարների քանակը:
(defun count-divisors (x)
   (labels
       ((divisors-rec (y)
            (cond
              ((= 1 y) 1)
              ((zerop (rem x y)) (1+ (divisors-rec (1- y))))
              (t (divisors-rec (1- y))))))
   (cond 
     ((<= x 3) 1)
     ((evenp x) (divisors-rec (/ x 2)))
     (t (divisors-rec (1- x))))))
28. Սահմանել ֆունկցիա, որը վերադարձնում է տրված \(x\) թվի բաժանարարների գումարը:
(defun sum-of-divisors (x)
    (labels
       ((sum-of-div-rec (y)
          (cond
              ((= 1 y) 1)
              ((zerop (rem x y)) (+ y (sum-of-div-rec (1- y))))
              (t (sum-of-div-rec (1- y))))))
    (cond
        ((<= x 3) 1)
        ((evenp x) (sum-of-div-rec (/ x 2)))
        (t (sum-of-div-rec (1- x))))))
29. Սահմանել ֆունկցիա, որը ստուգում է տրված \(x\) թվի պարզ լինելը:
(defun prime-p (x)
    (= 1 (count-divisors x)))
30. Սահմանել ֆունկցիա, որը վերադարձնում է տրված \(x\) թվից փոքր կամ հավասար պարզ թվերի քանակը:
(defun count-primes (x)
    (cond 
        ((zerop x) 0)
        ((prime-p x) (1+ (count-primes (1- x))))
        (t (count-primes (1- x)))))
31. Սահմանել ֆունկցիա, որը վերադարձնում է տրված \(x\) թվի պարզ բաժանարարների քանակը:
(defun count-prime-divisors (x)
   (labels
       ((divisors-rec (y)
            (cond
              ((= 1 y) 1)
              ((and (prime-p y) (zerop (rem x y))) (1+ (divisors-rec (1- y))))
              (t (divisors-rec (1- y))))))
   (cond 
     ((<= x 3) 1)
     ((evenp x) (divisors-rec (/ x 2)))
     (t (divisors-rec (1- x))))))
32. Սահմանել ֆունկցիա, որը ստուգում է տրված \(x\) թվի կատարյալ լինելը:
(defun perfect-p (x)
    (= x (sum-of-divisors x)))
33. Սահմանել \(eiler\) (?) ֆունկցիան. \(f(x)=f(0)\cdot\ldots\cdot f(x-1)+1\):
(defun f (x)
   (labels
     ((h (y)
        (if (= y 1)
            1
            (* (h (1- y)) (f (1- y))))))
   (if (zerop x)
       1
       (1+ (h x)))))
34. Սահմանել ֆունկցիա, որը ստուգում է տրված \(x\) թվի զույգ լինելը:
(defun is-even (x)
    (zerop (logand x 1)))
35. Սահմանել ֆունկցիա, որը ստուգում է տրված \(x\) թվի կենտ լինելը:
(defun is-odd(x)
    (not (iseven x)))

Ցուցակային ռեկուրսիա

36. Սահմանել len_ անունով ֆունկցիա, որը վերադարձնում է տրված \(x\) ցուցակի երկարությունը (տարրերի քանակը) և nil, եթե արգումենտը ցուցակ չէ:
(defun len_ (x)
    (if (and (atom x) (not (null x)))
        nil
        (if (endp x)
            0
            (1+ (len_ (cdr x))))))
37. Սահմանել ֆունկցիա, որը վերադարձնում է տրված ցուցակի տարրերի գումարը:
(defun sum-1 (x)
    (if (endp x)
        0
        (+ (car x) (sum-1 (cdr x)))))
38. Սահմանել ֆունկցիա, որը վերադարձնում է տրված ցուցակի զույգ տարրերի գումարը:
(defun sum-of-evens (x)
        (if (endp x)
            0
            (if (evenp (car x))
                (+ (car x) (sum-of-evens (cdr x)))
                (sum-of-evens (cdr x)))))
39. Սահմանել ֆունկցիա, որը վերադարձնում է բնական թվերի \(x\) գծային ցուցակի զույգ տարրերի ցուցակը:
(defun list-of-evens (x)
   (cond 
       ((endp x) '())
       ((evenp (car x)) (cons (car x) (list-of-evens (cdr x))))
       (t (list-of-evens (cdr x)))))
40. Սահմանել ֆունկցիա, որը վերադարձնում է բնական թվերի \(x\) գծային ցուցակի կենտ տարրերի գումարը:
(defun sum-of-odds (x)
   (cond
       ((endp x) 0)
       ((oddp (car x)) (+ (car x) (sum-of-odds (cdr x))))
       (t (sum-of-odds (cdr x)))))
41. Սահմանել ֆունկցիա, որը վերադարձնում է բնական թվերի \(x\) գծային ցուցակի կենտ տարրերի ցուցակը:
(defun list-of-odds (x)
   (cond
       ((endp x) '())
       ((oddp (car x)) (cons (car x) (list-of-odds (cdr x))))
       (t (list-of-odds (cdr x)))))
42. Սահմանել ֆունկցիա, որը վերադարձնում է բնական թվերի \(x\) գծային ցուցակի դրական տարրերի քանակը:
(defun count-positivs (x)
   (cond
       ((endp x) 0)
       ((plusp (car x)) (1+ (count-positivs (cdr x))))
       (t (count-positivs (cdr x)))))
43. Սահմանել ֆունկցիա, որը վերադարձնում է բնական թվերի \(x\) գծային ցուցակի դրական տարրերի ցուցակը:
(defun list-of-positivs (x)
   (cond
       ((endp x) '())
       ((plusp (car x)) (cons (car x) (list-of-positivs (cdr x))))
       (t (list-of-positivs (cdr x)))))
44. Սահմանել ֆունկցիա, որը վերադարձնում է բնական թվերի \(x\) գծային ցուցակի ոչ զրոյական տարրերի քանակը:
(defun count-non-zeros (x)
   (cond
       ((endp x) 0)
       ((not (zerop (car x))) (1+ (count-non-zeros (cdr x))))
       (t (count-non-zeros (cdr x)))))
45. Սահմանել ֆունկցիա, որը վերադարձնում է բնական թվերի \(x\) գծային ցուցակի ոչ զրոյական տարրերի ցուցակը:
(defun list-of-non-zeros (x)
   (cond
       ((endp x) '())
       ((not (zerop (car x))) (cons (car x) (list-of-non-zeros (cdr x))))
       (t (list-of-non-zeros (cdr x)))))
46. Սահմանել ֆունկցիա, որը վերադարձնում է բնական թվերի \(x\) գծային ցուցակի ամենամեծ տարրը:
(defun maximum (x)
   (if (endp (cdr x))
       (car x)
       (let ((m (maximum (cdr x)))
      (c (car x)))
  (if (> c m) c m))))
47. Սահմանել ֆունկցիա, որը վերադարձնում է բնական թվերի \(x\) գծային ցուցակի ամենափոքր տարրը:
(defun minimum (x)
   (if (endp (cdr x))
       (car x)
       (let ((m (minimum (cdr x)))
      (c (car x)))
  (if (< c m) c m))))
48. Սահմանել ֆունկցիա, որը վերադարձնում է բնական թվերի \(x\) ոչ գծային ցուցակի ամենամեծ տարրը:
(defun max-list (x)
   (flet ((max-2 (a b) (if (> a b) a b)))
       (let ((a (car x)) (d (cdr x)))
           (if (endp d)
               (if (atom a) a (max-list a))
               (max-2 (if (atom a) a (max-list a)) (max-list d))))))
49. Սահմանել ֆունկցիա, որը վերադարձնում է բնական թվերի \(x\) ոչ գծային ցուցակի ամենափոքր տարրը:
(defun min-list (x)
   (flet ((min-2 (a b) (if (< a b) a b)))
       (let ((a (car x)) (d (cdr x)))
           (if (endp d)
               (if (atom a) a (min-list a))
               (min-2 (if (atom a) a (min-list a)) (min-list d))))))
50. Սահմանել ֆունկցիա, որը վերադարձնում է բնական թվերի \(x\) գծային ցուցակի ոչ զրոյական տարրերից ամենամեծը:
(defun max-non-zero (x)
    (maximum (list-of-non-zeros x)))
51. Սահմանել ֆունկցիա, որը վերադարձնում է բնական թվերի \(x\) գծային ցուցակում \(y\)-ից մեծ և \(z\)-ին պատիկ թվերի քանակը:
(defun ex51 (x y z)
   (if (endp x)
       0
       (if (and (> (car x) y) (zerop (mod (car x) z)))
           (1+ (ex51 (cdr x) y z))
           (ex51 (cdr x) y z))))
52. Սահմանել ֆունկցիա, որը վերադարձնում է բնական թվերի \(x\) գծային ցուցակում \(y\)-ից մեծ և \(z\)-ին պատիկ թվերի ցուցակը:
(defun ex52 (x y z)
   (if (endp x)
       '()
       (if (and (> (car x) y) (zerop (mod (car x) z)))
           (cons (car x) (ex52 (cdr x) y z))
           (ex52 (cdr x) y z))))
53. Սահմանել ֆունկցիա, որը վերադարձնում է տրված \(x\) ցուցակի ատոմների քանակը (ցուցակը կարող է լինել նաև ոչ գծային):
(defun count-atoms (x)
   (cond
      ((endp x) 0)
      ((atom (car x)) (1+ (count-atoms (cdr x))))
      (t (+ (count-atoms (car x)) (count-atoms (cdr x))))))
54. Սահմանել ֆունկցիա, որը վերադարձնում է տրված ոչ գծային ցուցակի ատոմների ցուցակը:
(defun list-of-atoms (x)
   (cond
      ((endp x) '())
      ((atom (car x)) (cons (car x) (list-of-atoms (cdr x))))
      (t (append (list-of-atoms (car x)) (list-of-atoms (cdr x))))))
55. Սահմանել ֆունկցիա, որը վերադարձնում է տրված գծային ցուցակի \(n\)-րդ տարրը: Եթե ցուցակի երկարությունը փոքր է \(n\)-ից, ապա վերադարձնել ցուցակի երկարությունը՝ գումարած \(1\):
(defun n-th-elem (l n)
  (labels
    ((n-th-rec (j m)
        (cond
            ((endp j) (1+ m))
            ((= n m) (car j))
            (t (n-th-rec (cdr j) (1+ m))))))
    (n-th-rec l 0)))
56. Տարրական ֆունկցիաներով ծրագրավորել երկու ցուցակների միակցումը վերադարձնող ֆունկցիան:
(defun append-2 (x y)
    (if (endp x)
        y
        (cons (car x) (append-2 (cdr x) y))))
57. Սահմանել ֆունկցիա, որը վերադարձնում է տրված ցուցակի վերջին տարրը:
(defun last-elem (l)
    (if (endp (cdr l))
        (car l)
        (last-elem (cdr l))))
58. Սահմանել ֆունկցիա, որը տրված \(x\) ցուցակին աջից կցում է տրված \(y\) ատոմը:
(defun add-right (x y)
    (if (endp x)
        (cons y '())
        (cons (car x) (add-right (cdr x) y))))
59. Սահմանել պրեդիկատ, որը ստուգում է տրված \(e\) ատոմը գոյությունը \(l\) գծային ցուցակում:
(defun contains (l e)
    (cond
        ((endp l) nil)
        ((equal (car l) e) t)
        (t (contains (cdr l) e))))
60. Սահմանել պրեդիկատ, որը ստուգում է տրված \(e\) տարրի գոյությունը \(l\) ոչ գծային ցուցակում:
(defun contains-nl (l e)
   (if (endp l)
       nil
       (let ((a (car l)) (d (cdr l)))
         (or (if (atom a) 
                 (equal a e)
                 (contains-nl a e))
             (contains-nl d e)))))
61. Սահամնել ֆունկցիա, որը վերադարձնում է \(l\) ցուցակում \(e\) տարրի դիրքը: Եթե \(e\)-ն ցուցակում բացակայում է, ապա վերադարձնել ցուցակի երկարությունը՝ գումարած \(1\):
(defun elem-pos (l e)
  (labels
      ((elem-pos-rec (j m)
          (cond
             ((endp j) (1+ m))
             ((equal (car j) e) m)
             (t (elem-pos-rec (cdr j) (1+ m))))))
    (elem-pos-rec l 0)))
62. Սահմանել ֆունկցիա, որը վերադարձնում է \(l\) ցուցակում \(e\) տարրին հաջորդող տարրը: եթե այդպիսին չկա, վերադարձնել nil:
(defun next-elem (l e)
    (cond
        ((or (endp l) (endp (cdr l))) nil)
        ((equal (car l) e) (cadr l))
        (t (next-elem (cdr l) e))))
63. Սահմանել ֆունկցիա, որը վերադարձնում է \(l\) ցուցակում \(e\) տարրերի քանակը:
(defun count-elem (l e)
    (cond
        ((endp l) 0)
        ((equal (car l) e) (1+ (count-elem (cdr l) e)))
        (t (count-elem (cdr l) e))))
64. Սահմանել ֆունկցիա, որը վերադարձնում է \(l\) ցուցակի շրջված ցուցակը:
(defun rev-list (l)
  (labels
      ((rev-rec (l r)
  (if (endp l)
      r
      (rev-rec (cdr l) (cons (car l) r)))))
    (rev-rec l '())))
65. Սահմանել ֆունկցիա, որը աճման կարգով կարգավորված բնական թվերի \(l\) ցուցակում ավելացնում է \(e\) տարրը:
(defun insert-elem (l e)
  (if (endp l)
      (cons e '())
      (if (< e (car l))
   (cons e l)
   (cons (car l) (insert-elem (cdr l) e)))))
66. Սահմանել ֆունկցիա, որը վերադարձնում է տրված ցուցակը՝ կարգավորված ըստ տարրերի արժեքների աճման:
(defun insertion-sort (x)
    (if (endp l)
        '()
        (insert-elem (insertion-sort (cdr x)) (car x))))
67. Սահմանել ֆունկցիա, որը վերադարձնում է տրված ցուցակը՝ կարգավորված ըստ տարրերի արժեքների նվազման:
(defun sort-desc (x)
    (rev-list (insertion-sort x)))
68. Սահմանել ֆունկցիա, որը հեռացնում է տրված ցուցակի վերջին տարրը:
(defun rem-last (x)
    (if (or (endp x) (endp (cdr x)))
        '()
        (cons (car x) (rem-last (cdr x)))))
69. Սահմանել ֆունկցիա, որը հեռացնում է տրված ցուցակում առաջին զույգ թվին հաջորդող տարրը:
(defun rem-next-to-even (x)
  (cond
    ((endp x) '())
    ((evenp (car x)) (cons (car x) (cddr x)))
    (t (cons (car x) (rem-next-to-even (cdr x))))))
70. Սահմանել ֆունկցիա, որը տրված ցուցակում բոլոր կենտ թվերը փոխարինում է իրենց քառակուսով:
(defun odd-to-sqr (x)
  (if (endp x)
      '()
      (let ((a (car x)) (d (cdr x)))
        (cons (if (oddp a) (* a a) a) (odd-to-sqr d)))))
71. Սահմանել ֆունկցիա, որը տրված ցուցակում բոլոր զույգ դիրքերում կանգնած \(a\)-երը փոխարինում է \(b\)-երով:
(defun ex71 (x a b)
  (if (or (endp x) (endp (cdr x)))
      '()
      (cons (car x) 
        (cons (if (equal (cadr x) a) b (cadr x)) 
              (ex71 (cddr x) a b)))))
72. Սահմանել ֆունկցիա, որը սիմվոլների \(x\) գծային ցուցակում \(y\) սիմվոլի բոլոր մուտքերը պատճենում է:
(defun ex72 (x y)
  (if (endp x)
      '()
      (if (equal (car x) y) 
          (append (list y y) (ex72 (cdr x) y))
          (cons (car x) (ex72 (cdr x) y)))))
73. Սահմանել պրեդիկատ, որը ստուգում է արդյոք տրված ցուցակը կազմված է nil-ից տարբեր ատոմներից:
(defun no-nils (x)
  (if (endp x)
      t
      (and (not (null (car x)))
           (no-nils (cdr x)))))
74. Սահմանել ֆունկցիա, որը սիմվոլներից կազմված \(x\) գծային ցուցակում բոլոր a-երը փոխարինում է b-երով:
(defun ex74 (x a b)
  (if (endp x)
      '()
      (cons (if (eq (car x) a) b (car x))
            (ex74 (cdr x) a b))))
75. Սահմանել պրեդիկատ, որը ստուգում է տրված ցուցակի գծային լինելը:
(defun linear-p (x)
  (if (endp x)
      t
      (and (atom (car x)) (linear-p (cdr x)))))
76. Սահմանել ֆունկցիա, որը տրված \(x\) գծային ցուցակից ստանում է նոր ցուցակ հետևյալ կերպ.
(a b c) -> (((c) b) a)
(defun ex76 (x)
  (cond 
    ((endp x) (print x) '())
    ((endp (cdr x)) (cons (car x) '()))
    (t (list (ex76 (cdr x)) (car x)))))
77. Սահմանել ֆունկցիա, որը տրված \(x\) գծային ցուցակից ստանում է նոր ցուցակ հետևյալ կերպ.
(a b c) -> (a (b (c)))
(defun ex77 (x)
  (cond 
    ((endp x) (print x) '())
    ((endp (cdr x)) (cons (car x) '()))
    (t (list (car x) (ex77 (cdr x))))))
78. Սահմանել ֆունկցիա, որը տրված \(x\) գծային ցուցակից ստանում է նոր ցուցակ հետևյալ կերպ.
(a b c) -> (((a) b) c)
(defun ex78 (x)
  (ex76 (reverse x)))
79. Սահմանել ֆունկցիա, որը տրված \(x\) գծային ցուցակից ստանում է նոր ցուցակ հետևյալ կերպ.
(((a) b) c) -> (a b c)
(defun ex79 (x)
  (if (atom x)
      (cons x '())
      (append (ex79 (car x)) (cdr x))))
80. Սահմանել ֆունկցիա, որը տրված \(x\) և \(y\) գծային ցուցակներից ստանում է նոր ցուցակ հետևյալ կերպ.
(a b c),(1 2 3) -> ((a 1)(b 2)(c 3))
(defun zip (x y)
  (if (or (endp x) (endp y))
      '()
      (cons (list (car x) (car y))
            (zip (cdr x) (cdr y)))))
81. Սահմանել ֆունկցիա, որը տրված \(x\) գծային ցուցակից ստանում է նոր ցուցակ հետևյալ կերպ.
(a b c d e f) -> ((a b)(c d)(e f))
(a b c d e) -> ((a b)(c d)(e nil))
(defun zip-2 (x)
  (if (endp x)
      '()
      (cons (list (car x) (cadr x))
            (zip-2 (cddr x)))))
82. Սահմանել ֆունկցիա, որը վերադարձնում է \(x\) ցուցակի խորությունը:
  
(defun depth-1 (x)
  (if (or (not (listp x)) (null x))
      0
      (1+ (apply #'max (mapcar #'depth-1 x)))))
83. Սահմանել ֆունկցիա, որը վերադարձնում է \(x\) ոչ գծային ցուցակի խորությունը:
(defun depth-2 (x)
  (if (atom x)
      0
      (1+ (apply #'max (mapcar #'depth-2 x)))))
84. Սահմանել տրված ցուցակի սիմետրիկությունը ստուգող պրեդիկատ:
(defun palindrome-p (x)
  (equal (reverse x) x))

(defun palindrome-p-2 (x) (print x)
  (if (or (endp x) (endp (cdr x)))
      t
      (and (equal (first x) (car (last x)))
           (palindrome-p-2 (butlast (cdr x))))))
85. Սահմանել պրեդիկատ, որը ստուգում է արդյոք \(x\) ցուցակը \(y\) ցուցակի սկիզբն է:
(defun prefix-p (x y)
  (if (endp y)
      t
      (and (equal (car x) (car y))
           (prefix-p (cdr x) (cdr y)))))
86. Սահմանել ֆունկցիա, որը տրված \(x\) ցուցակի սկզբից հեռացնում է \(y\) ցուցակին համապատասխանող տարրերը:
(defun ex86 (x y)
  (if (prefix-p x y)
      (nthcdr (list-length y) x)
      x))
87. Սահմանել պրեդիկատ, որը ստուգում է արդյոք տրված \(x\) ցուցակը \(y\) ցուցակի իտերացիան է:
(defun ex87 (x y)
  (if (equal x y)
      t
      (if (prefix-p x y)
          (ex87 (nthcdr (list-length y) x) y)
          nil)))
88. Սահմանել ֆունկցիա, որն արգումենտում ստանում է ինֆիքսային տեսքով գրված արտահայտություն (ցուցակի տեսքով, առանց հաշվի առնելու գործողությունների առաջայնությունը, բոլոր գործողություները երկտեղանի են) և վերադարձնում է նրա արժեքը:
((-2 + 4) * 3) -> 6
(-2 + (4 * 3)) -> 10
((-2 > 0) and (3 < 5)) -> t
-2 -> -2
(defun calc (x)
  (flet
    ((func-op (op)
       (case op
         ((and) #'(lambda (a b) (and a b)))
         ((or) #'(lambda (a b) (or a b)))
         (t op))))
   (if (atom x)
       x
      (funcall (func-op (second x))
               (calc (first x))
               (calc (third x))))))

Խնդիրներ բազմությունների վերաբերյալ

89. Սահմանել is-in պրեդիկատը, որը վերադարձնում է t, եթե y-ը x բազմության տարր է: Հակառակ դեպքում վերադարձնում է nil:
(defun is-in (y x)
  (if (endp x)
      nil
      (or (equal (car x) y) (is-in y (cdr x)))))
90. Սահմանել is-set պրեդիկատը, որը ստուգում է տրված ցուցակի բազմություն լինելը:
(defun is-set (x)
  (if (endp x)
      t
      (and (not (is-in (car x) (cdr x)))
           (is-set (cdr x)))))
91. Սահմանել list-to-set ֆունկցիան, որը վերադարձնում է տրված գծային ցուցակի տարրերի բազմությունը:
(defun list-to-set (x)
  (cond
    ((endp x) '())
    ((member (car x) (cdr x)) (list-to-set (cdr x)))
    (t (cons (car x) (list-to-set (cdr x))))))
92. Սահմանել list-set ֆունկցիան, որը վերադարձնում է տրված ոչգծային ցուցակի տարրերի բազմությունը:
(defun tree-to-set (x)
  (labels
     ((flatten (y)
       (cond
         ((null y) '())
         ((atom y) (list y))
         (t (mapcan #'flatten y)))))
    (list-to-set (flatten x))))
93. Սահմանել set-of-evens ֆունկցիան, որը վերադարձնում է տրված \(X\) բնական թվերի ցուցակի զույգ տարրերի բազմությունը:
(defun set-of-evens (x)
  (remove-duplicates (remove-if #'oddp x)))

(defun set-of-evens-1 (x)
  (if (endp x)
      '()
      (let ((head (car x))
            (tail (set-of-evens-1 (cdr x))))
        (if (and (evenp head) (not (member head tail)))
            (cons head tail)
            tail))))
94. Սահմանել set-not-zero ֆունկցիան, որը վերադարձնում է տրված \(X\) բնական թվերի ցուցակի ոչզրոյական տարրերի բազմությունը:
        
(defun set-not-zero (x)
  (remove-duplicates (remove-if #'zerop x)))
95. Սահմանել lonion ֆունկցիան, որը վերադարձնում է տրված երկու բազմությունների միավորումը:
      
(defun lunion (x y)
  (cond
    ((endp x) y)
    ((member (car x) y) (lunion (cdr x) y))
    (t (cons (car x) (lunion (cdr x) y)))))
96. Սահմանել union-of-odds ֆունկցիան, որը վերադարձնում է տրված երկու բազմությունների կենտ տարրերի ենթաբազմությունների միավորումը:
(defun union-of-odds (x y)
  (union (remove-if-not #'oddp x) (remove-if-not #'oddp y)))
97. Սահմանել lintersection ֆունկցիան, որը վերադարձնում է տրված երկու բազմությունների հատումը:
(defun lintersection (x y)
  (cond
    ((or (endp x) (endp y)) '())
    ((member (car x) y) (cons (car x) (lintersection (cdr x) y)))
    (t (lintersection (cdr x) y))))
98. Սահմանել ֆունկցիա, որը վերադարձնում է տրված երկու բազմությունների թիվ հանդիսացող ատոմների հատումը:
(defun ex98 (x y)
  (intersection (remove-if-not #'numberp x)
                (remove-if-not #'numberp y)))
99. Սահմանել ֆունկցիա, որը վերադարձնում է տրված երկու բազմությունների տարբերությունը:
(defun ldifference (x y)
  (cond
    ((endp x) '())
    ((endp y) x)
    ((member (car x) y) (ldifference (cdr x) y))
    (t (cons (car x) (ldifference (cdr x) y)))))
100. Սահմանել ֆունկցիա, որը վերադարձնում է տրված երկու բազմությունների սիմետրիկ հանումը:
(defun sim-diff (x y)
  (set-difference (union x y) (intersection x y)))
101. Սահմանել երկու բազմությունների դեկարտյան արտադրյալը վերադարձնող ֆունկցիա:
(defun cartesian (x y)
  (if (endp x)
      '()
      (append (mapcar #'(lambda (e) (list (car x) e)) y)
              (cartesian (cdr x) y))))
102. Սահմանել պրեդիկատ, որը ստուդում է երկու բազմությունների հատվող լինելը:
(defun are-intersect (x y)
  (if (endp x)
      nil
      (or (member (car x) y) (are-intersect (cdr x) y))))

(defun are-intersect-2 (x y)
  (not (null (intersection x y))))
103. Սահմանել պրեդիկատ, որը ստուդում է երկու բազմությունների չհատվող լինելը:
(defun are-not-intersect (x y)
    (null (intersection x y)))
104. Սահմանել is-subset ֆունկցիան, որը ստուգում է. արդյոք տրված \(X\) բազմությանը \(Y\) բազմության ենթաբազմություն է:
(defun is-subset (x y)
  (if (endp x)
      t
      (and (member (car x) y) (is-subset (cdr x) y))))
105. Սահմանել is-own-subset ֆունկցիան, որը ստուգում է. արդյոք տրված \(X\) բազմությանը \(Y\) բազմության սեփական ենթաբազմություն է:
(defun is-own-subset (x y)
    (and (is-subset x y) (> (list-length y) (list-length x))))

Monday, March 31, 2014

Java և Kawa: Տեքստի տրոհումը Scanner դասի օգնությամբ

Շարունակելով բլոգիս «Tcl: Բառարանների օգտագործումը», «Python: Բառարանի օգտագործումը» և «C++11: Տեքստի տրոհումը բառերի՝ istream-ի միջոցով» գրառումների թեման, ես ուզում էի այս գրառմանս մեջ պատմել Java լեզվի միջոցներով տեքստը բառերի տրոհելու և բառերի հաճախությունը հաշվելու մասին։ Ինձ գայթակղեց Java-ի Scvanner դասը, որը կարելի է կանոնավոր արտահայտությունների միջոցով կարգավորել տեքստից բառեր կարդալու համար։ Բայց այս գրառման մեջ ուզում եմ նաև Java-ի HashMap բառարանի օգտագործումը համեմատ ել JVM վիրտուալ մեքենայով աշխատող GNU Kawa լեզվի (Scheme լեզվի իրականացում) hashtable բառարանի օգտագործման հետ։

Նախ ներկայացնեմ Java տարբերակը (օգտագործված է JDK 8-ը)։
package wordcount;

import java.io.File;
import java.io.FileNotFoundException;
import java.util.HashMap;
import java.util.Scanner;

/**/
public class WordCount {
  /**/
  private static void readFile( String name, HashMap<String,Integer> words )
  {
    // տրված անունով ֆայլի համար ստեղծել Scanner օբյեկտ
    try( Scanner scan = new Scanner(new File(name)) ) {
      // բացի մեծատառերից ու փոքրատառերից ամեն ինչ համարել բաժանիչ
      scan.useDelimiter( "[^A-Za-z]+" );
      // քանի դեռ Scanner-ից կարելի է կարդալ
      while( scan.hasNext() ) {
        // կարդալ հերթական բառը
        String wo = scan.next().toLowerCase();
        // գտնել կարդացած բառի արտապատկերումը բառարանում
        Integer co = words.get(wo);
        // եթե այդ բառը բառարանում չկա, ավելացնել այն՝ 1 քանակով, 
        // իսկ եթե կա՝ քանակն ավելացնել 1-ով
        words.put(wo, co == null ? 1 : co + 1);
      }
    }
    catch( FileNotFoundException ex ) {
      System.err.println(ex.getMessage());
    }
  }
    
  /**/
  public static void main(String[] args) 
  {
    // ստեղծել String->Integer արտապատկերում
    HashMap<String,Integer> words = new HashMap<>();
    // կարդալ ֆայլի պարունակությունը words բառարանի մեջ
    readFile("~/Projects/martineden.txt", words);
    // բառ-քանակ զույգերն արտածել ստանդարտ արտածման հոսքին
    words.forEach( (k,v) -> System.out.printf("%s\t%s\n", k, v) );
  }
}
* * *
Kawa լեզուն JVM վիրտուալ մեքենայի համար գրված բազմաթիվ լեզուներից մեկն է։ Բայց ինձ համար հետաքրքիր է նրանով, որ այն Lisp լեզվի Scheme դիալեկտի իրականացում է Java լեզվով։ Ամբողջովին գրված լինելով Java լեզվով՝ այն ա) պլատֆորմից անկախ է, և բ) հնարավորություն ունի օգտագործել Java լեզվի ստանդարտ գրադարանը՝ այն ամենը, ինչ մատչելի է JVM կատարման միջավայրում։

Հիմա ցույց տամ, թե ինչպես եմ Kawa լեզվի միջոցներով կարդում ֆայլի բառերի հաջորդականությունը և կազմում դրանց հաճախությունների բառարանը։ Նախ սահմանեմ read-all-words ֆունկցիան, որն արգումենտում ստանում է Java լեզվի Scanner օբյեկտը և վերագարձնում է տեքստի բառերի հաճախությունների բառարանը՝ որպես Scheme լեզվի hashtable օբյեկտ։
(define (read-all-words sca :: Scanner)
  (define (read-all-words-rec ht)
    (when (invoke sca 'hasNext)
      (add-to-table (string-downcase (invoke sca 'next)) ht)
      (read-all-words-rec ht)))
  (let ((words (make-hashtable string-hash string=?)))
    (read-all-words-rec words)
    words))
read-all-words ֆունկցիայի համար սահմանված է read-all-words-rec լոկալ ռեկուրսիվ ֆունկցիան, որը Scanner օբյեկտից կարդում է մեկ բառ, այդ բառի բոլոր մեծատառերը դարձնում է փոքրատառ՝ string-downcase ֆունկցիայով, ապա ավելացնում է արգումենտում տրված բառարանում։ Բառարանը ստեղծվում է որպես read-all-words ֆունկցիայի լոկալ օբյեկտ՝ make-hashtable ֆունկցիայով։ Բառը բառարանում ավելացնող add-to-table ֆունկցիան սահմանված է հետևյալ կերպ․
(define (add-to-table w table)
  (let ((co (hashtable-ref table w 0)))
    (hashtable-set! table w (+ co 1))))
read-file ֆունկցիան, որ կսահմանեմ ստորև, տրված ֆայլի անունի համար ստեղծում է մի Scanner օբյեկտ և "[^A-Za-z]+" արտահայտությունը սահմանում է որպես դրա բաժանիչ։ Հետո read-all-words ֆունկցիայով ստանում է բառերի հաճախությունների բառարանը, այդ բառարանից կազմում է կետով զույգերի (dotted pair) ցուցակ, և վերադարձնում է այդ վերջին ցուցակն՝ ըստ բառերի այբբենական կարգի կարգավորած։
(define (read-file name :: )
  (let ((sca (Scanner:new (File:new name))))
    (invoke sca 'useDelimiter "[^A-Za-z]+")
    (let-values (((ks vs) (hashtable-entries (read-all-words sca))))
      (invoke sca 'close)
      (list-sort (lambda (a b) (stringlist ks) (vector->list vs))))))
* * *
Ինձ դուր է գալիս Lisp լեզվով ծրագրավորումը։ Բայց ինձ դուր է գալիս նաև Java լեզվի գրադարանները։ Kawa իրականացումը հնարավորություն է տալիս մեկտեղել երկու դուրեկան բան :)

Thursday, February 20, 2014

Common Lisp: Առաջին հայերեն գիրքը

Արդեն բավականին ժամանակ է, որ ես աշխատում եմ «Common Lisp։ 12 օրինակ» գրքի վրա։ Գիրքը պարունակում է ծրագրավորման 12 հայտնի խնդիրներ՝ ներկայացված Common Lisp լեզվով։ Տասներկու գլուխներից առաջին ութն արդեն պատրաստ են։ Մյուսների վրա շարունակում եմ աշխատանքը և շուտով կվերջացնեմ։

Ահա գրքի առաջին երկու գլուխները. https://github.com/armenbadal/clne

Saturday, January 25, 2014

Դետերմինացված վերջավոր ավտոմատ - DFA

Դետերմինացված վերջավոր ավտոմատը (DFA) մի վիտուալ մեքենա է, որ բաղկացած է ղեկավարող սարքից, ինֆորմացիան կրող ժապավենից և ժապավենի հերթական բջջի նիշը կարդացող և ղեկավարող սարքին փոխանցող գլխիկից։

Դետերմինացված վերջավոր ավտոմատի վարքը սահմանվում է մի հնգյակով՝ \(A=\langle\Sigma, Q, q_0, F, \delta\rangle\), որտեղ \(\Sigma\)-ն ժապավենի վրա թուլատրված նիշերի բազմությունն է, \(Q\)-ն ղեկավարող սարքի ներքին վիճակների բազմությունն է, \(q_0\)-ն այն ներքին վիճակն է, որում ավտոմատը գտնվում է աշխատանքը սկսելու պահին, \(F\)-ը ճանաչող (հաստատող, թույլատրող) վիճակների բազմությունն է, որոնցում ավտոմատը կարող է դադարեցնել իր աշխատանքը, և \(\delta\)-ն \(Q\times\Sigma\to Q\) տիպի ֆունկցա է, որը ավտոմատի ներքին վիճակը փոխում է ըստ ընթերցող գլխիկի տված նիշի և ավտոմատի ընթացիկ ներքին վիճակի։

Օրինակ, «\(a^{+}b^{+}\)» կանոնավոր արտահայտությամբ որոշվող տողերը ճանաչող ավտոմատի համար \(\delta\) ֆունկցիան ունի հետևյալ տեսքը. \[ \delta(q_0,a)=q_1, \quad \delta(q_1,a)=1_1, \quad \delta(q_1,b)=q_2, \quad \delta(q_2,b)=q_2: \]
Համարվում է, որ ավտոմատը ճանաչել է նիշերի տրված հաջորդականությունը, եթե ընթերցող գլխիկը, դեպի աջ շարժվելով, ժապավենի վրա հասել է վերջին նիշին հաջորդող դիրքին և ավտոմատի ներքին վիճակը պատկանում է \(F\) բազմությանը։

Քանի որ ավտոմատի ընթերցող գլխիկը կարող է տեղաշարժվել միայն դեպի աջ, ապա ժապավենը կարելի է մոդելավորել ցուցակով, իսկ գլխիկի տեղաշարժը՝ ցուցակի հերթական տարրը հեռացնելով։
* * *
Ավտոմատի մոդելի սահմանումը շատ պարզ է.
(defstruct automata
    alphabet    ; այբուբենի նիշերի բազմություն
    states      ; վիճակների բազմություն
    initial     ; սկզբնական վիճակ
    finals      ; ճանաչող վիճակների բազմություն
    commands    ; վիճակի փոփոխման ֆունկցիան
)
Օրինակ, վերը հիշատակված ավտոմատը նկարագրելու համար պետք է գրել.
(defvar *a0*
  (make-automata
    :alphabet '(#\a #\b)
    :states '(s0 s1 s2)
    :initial 's0
    :finals '(s2)
    :commands 
       '((s0 #\a . s1)
         (s1 #\a . s1)
         (s1 #\b . s2)
         (s2 #\b . s2))))
\(\delta\) ֆունկցիայի վարքը նկարագրող ցուցակի ամեն մի տարրը կետով ցուցակով է, որի առաջին երկու տարրերը ֆունկցիայի արգումենտներն են, իսկ երրորդը՝ արժեքը։ Ավտոմատի commands ատրիբուտի (սլոտի) մեջ տրված արգումենտներին համապատասխանող արժեքը որոնելու համար սահմանված ֆունկցիան պարզապես անցնում է ցուցակի տարրերով և վերադարձնում է անհրաժեշտ եռյակի երրորդ տարրը։ Եթե տրված արգումենտներին համապատասխանող եռյակ չկա, ապա վերադարձնում է nil։
(defun delta (au s c)
  (loop for tri in (automata-commands au)
        when (and (eql s (car tri)) (char= c (cadr tri)))
        do (return (cddr tri))))
Սահմանված ավտոմատը նիշերի տրված ցուցակի վրա գործարկելու համար պետք է կարդալ ժապավենի հերթական սիմվոլը, համադրել այն ավտոմատի ներքին վիճակի հետ և ավտոմատի հրամանների ցուցակում որոնել այդ զույգին համապատասխան եռյակը։ automata-run ֆունկցիան ավտոմատի ինտերպրետատորի ռեկուրսիվ իրականացումն է։
(defun automata-run (machine tape start)
  (let ((e (endp tape))
        (f (member start (automata-finals machine))))
    (cond
      ((and e f) t)
      ((and e (not f)) nil)
      (t (automata-run machine (cdr tape) (delta machine start (car tape)))))))
Այս ֆունկցիայի առաջին արգումենտը ավտոմատն է, երկրորդը՝ ժապավենը մոդելավորող ցուցակը, իսկ երրորդը՝ այն վիճակն է, որից պետք է սկսել ինտերպրետացիան։

Մի որևէ նիշերի տող ավտոմատով ճանաչելու համար պետք է տողի պարունակությունը գրել ժապավենի վրա և ավտոմատը գործարկել սկզբնական վիճակից։ Քանի որ ժապավենը մոդելավորված է ցուցակով, պիտի գրել մի մակրոս, որը ողը ձևափոխում է նիշերի ցուցակի․
(defmacro string-to-list (s)
  `(loop for c across ,s collect c))
recognize-with վերադարձնում է T, եթե տրված ավտոմատը ճանաչել է տրված տողը, և NIL՝ հակառակ դեպքում։
(defun recognize-with (machine cstring)
  (automata-run machine (string-to-list cstring) (automata-initial machine)))
Եվ ահա գործարկման մի քանի օրինակ․
(print (recognize-with *b* "0100"))
(print (recognize-with *b* "ab"))
(print (recognize-with *b* "aaaab"))
(print (recognize-with *b* "abbbbb"))
(print (recognize-with *b* "aaaabbbbb"))

Monday, January 6, 2014

Հիշող սարք և տեստային ալգորիթմ

Ուսանողական առաջադրանքներից մեկում ես հանձնարարել էի գրել մի կոմպիլյատոր, որը թվային հիշող սարքի և տեստավորման ալգորիթմի տեքստային ներկայացումից կոմպիլյացնում է տեստավորող մեքենային կոդ։ Նկարագրման լեզվի քերականությունը մոտավորապես հետևյալն էր․
     script = { memory | algorithm | test }.
     memory = 'Memory' IDENT '{' 'Rows' '=' NUMBER 'Columns' '=' NUMBER '}'.
  algorithm = 'Algorithm' IDENT '{' { element } '}'.
    element = ('->'|'<-') '(' operation {',' operation } ')'.
  operation = (W|R)('0'|'1').
       test = 'Test' IDENT 'With' IDENT.
Այս քերականությամբ, օրինակ, կարելի է նկարագրել \(3\times2\) չափի հիշողության մատրից և նրա վրա գործարկել \(\Uparrow(W0);\Downarrow(W1,R1)\) պարզագույն տեստը։
  Memory r3c2 {
    Rows = 3
    Columns = 2
  }

  Algorithm A0 {
    ->(W0)
    <-(W1,R1)
  }

  Test r3c2 With A0
Այս սկրիպտի կոմպիլյացիայից հետո պետք է կառուցվեր տեստավորող մեքենայի՝ սիմուլյատորի մի այստպիսի կոդ․
  0 0 W 0
  0 1 W 0
  1 0 W 0
  1 1 W 0
  2 0 W 0
  2 1 W 0
  0 0 W 1
  0 0 R 1
  0 1 W 1
  0 1 R 1
  1 0 W 1
  1 0 R 1
  1 1 W 1
  1 1 R 1
  2 0 W 1
  2 0 R 1
  2 1 W 1
  2 1 R 1
Քառյակի առաջին տարրը տողի հասցեն է, երկրորդը՝ սյան, երրորդ տարրը գործողությունն է՝ W - գրել, R - կարդալ, չորրորդ տարրը գործողության արգումենտն է։

Այս քառյակները հիշողության սարքի մոդելի վրա սիմուլյացնելու համար պետք է նախ՝ ստեղծել փչացած բջիջներ պարունակող հիշողության մոդել, ապա քառյակների սիմուլյացիայի արդյունքում պարզել, թե որ հասցեում է տեստավորման ալգորիթմը ձախողվում։
* * *
Սիմուլյատորի հիմնական գաղափարը հիշող սարքի բջիջն է, որում կարելի արժեք արժեք գրել և կարդալ սպասվող արժեք։ Այդ երկու գործողություններն ունեն այսպիսի ինտերֆեյս.
(defgeneric write-cell (c v))
(defgeneric read-cell (c))
Ճիշտ աշխատող բջիջը նկարագրել եմ cell անունով դասով․
(defclass cell ()
  ((value :initform 0
          :initarg :value
          :accessor cell-value)))
Որի համար գրելու գործողությունը տրված արժեքը վերագրում է value սլոտին, իսկ կարդալու գործողությունը վերադարձնում է value սլոտի արժեքը։
(defmethod write-cell ((c cell) v)
  (setf (cell-value c) v))
(defmethod read-cell ((c cell) v)
  (cell-value c))
Որպես օրինակ cell դասն ընդլայնել եմ և ստեղծել եմ cell-co դասը, որի կարդալու գործողությունը միշտ վերադարձնում է նախապես տրված հաստատուն արժեքը։
(defclass cell-co (cell) 
  ((coval :initform 0
          :initarg :coval
          :accessor cell-co-val)))

(defmethod read-cell ((c cell-co) v)
  (cell-co-val c))
Հիշող սարքի մոդելը երեք սլոտներով մի ստրուկտուա է․
(defstruct memory
  (rows 0)
  (columns 0)
  (matrix nil))
Հիշողության մոդելի կոնստրուկտորը մատրիցի բջիջները լրացնում է cell դասի օբյեկտներով։
(defun create-memory (row col)
  (let ((res (make-memory :rows row :columns col
                          :matrix (make-array (list row col)))))
    (dotimes (r (memory-rows res))
      (dotimes (c (memory-columns res))
        (setf (aref (memory-matrix res) r c)
              (make-instance 'cell :value 0))))
    res))
Հիշողության մոդելի համար նույնպես իրականացրել եմ գրելու և կարդալու գործողությունները։ Գրելու գործողությունը տրված արժեքը գրում է մատրիցի տրված կոորդինատներով բջջի մեջ, իսկ կարդալու գործողությունը տրված արժեքը համեմատում է մատրիցի տրված բջջի արժեքի հետ։ Քանի որ սա տեստավորման ալգորիթմները փորձարկելու համար նախատեսված մոդել է, այսպիսի վարքը լրիվ արդարացված է։
(defmethod write-memory ((m memory) r c v)
  (write-cell (aref (memory-matrix m) r c) v))
(defmethod read-memory ((m memory) r c v)
  (= (read-cell (aref (memory-matrix m) r c)) v))
Կոմպիլյացված ալգորիթմը հիշող սարքի մոդելի վրա գործարկելու համար նախատեսել եմ run-algorithm-on ֆունկցիան։ Այն արգումենտում ստանում է հիշողության մոդելը և քառյակների ֆայլը։
(defun run-algorithm-on (mem alg)
  (dolist (co (read-whole-algorithm alg))
    (let ((r (first co)) (c (second co)) (a (fourth co)))
      (if (eql 'W (third co))
        (write-memory mem r c a)
        (unless (read-memory mem r c a)
          (format t "ՍԽԱԼ։ Տեստը ձախողվեց (~D, ~D) բջջի վրա։~%" r c))))))
run-algorithm-on ֆունկցիայում քառյակների ֆայլը բեռնվում է որպես Lisp լեզվի ցուցակ read-whole-algorithm ֆունկցիայով։
(defun read-whole-algorithm (src)
  (labels
    ((read-one-command (cs)
       (let ((s (read-line cs nil)))
         (when s
           (read-from-string (concatenate 'string "(" s ")")))))
     (read-all-commands (cs res)
       (let ((c (read-one-command cs)))
         (if (null c)
           res
           (read-all-commands cs (cons c res))))))
  (with-open-file (inp src :direction :input)
    (reverse (read-all-commands inp '())))))
Հիմա մի օրինակ։ Ենթադրենք \(3\times2\) չափի հիշողության \((1,1)\) բջիջը անսարք է և բոլոր կարդալու գործողությունների ժամանակ վերադարձնում է \(0\) արժեքը։
(defvar *m* (create-memory 3 2))
(setf (aref (memory-matrix *m*) 1 1) (make-instance 'cell-co :coval 0))
(run-algorithm-on *m* "test1.alg")
Վերը բերված ալգորիթմը փչացած բջջով մոդելի վրա աշխատեցնելուց հետո ստանում եմ այսպիսի պատասխան․
ՍԽԱԼ։ Տեստը ձախողվեց (1, 1) բջջի վրա։
Որից երևում է, որ ալգորիթմը բջնում է անսարքությունը և սիմուլյատորն էլ անում է իր գործը։

Friday, December 13, 2013

Ստեկային մեքենայի մոդել։ Մաս I

Պատկերացենք մի վերացական համակարգիչ, որի պրոցեսորի հրամանները նախատեսված են ստեկային վարքով աշխատելու համար։ Օրինակ ADD հրամանը արգումենտներ չունի, այլ վերցնում է ստեկի գագաթի երկու տարրերը, դրանք գումարում է իրար և արդյունքը նորից գրում է ստեկում։ Ենթադրենք, թե մեքենան կարող է աշխատել միայն ամբողջ թվերի հետ։

Ֆիզիկական կառուցվածքի տեսակետից այդ մեքենան (ստեկային համակարգիչը) ունի ընդհանուր օգտագործման հիշողություն, որում պահվում են կատարվող ծրագիրը, ստատիկ տվյալները, գլոբալ փոփոխականներ, և հենց այդ հիշողության ինչ-որ տիրույթում մոդելավորվում է ստեկը։
(defconstant +size+ 1024 "Հիշողության չափը")
(defparameter *memory* (make-array +size+)
  "Հիշողությունը որպես տրված չափի զանգված")
Մեքենան ունի նաև երեք ռեգիստրներ. ա) հերթական հատարվող հրամանի ցուցիչ՝ IP, բ) ստեկի գագաթի ցուցիչ՝ SP և գ) ստեկի կադրի ցուցիչ՝ FP, որը ֆունկցիաների կանչի ժամանակ օգտագործվում է ֆունկցիայի արգումենտներին և լոկալ փոփոխականների հասցեներին դիմելու համար։
(defparameter *ip* -1 "Հերթական հրամանի ցուցիչ")
(defparameter *sp* -1 "Ստեկի ցուցիչ")
(defparameter *fp* -1 "Ստեկի կադրի ցուցիչ")
Պարզության համար ընդունենք, որ կատարվող ծրագիրը բեռնվում է հիշողության 0 հասցեից։ Ծրագիր զբաղեցրած տիրույթին հաջորդում է ստատիկ տվյալների և գլոբալ փոփոխականների տիրույթը՝ տվյալների սեգմենտը։ Իսկ տվյալների սեգմենտին հաջորդում է ստեկի սեգմենտը։ Օրինակ, եթե հիշողության մեջ բեռնվել է 16 հրամաններից բաղկացած ծրագիր, որում կան 8 գլոբալ փոփոխականներ, ապա կոդի սեգմենտը կսկսվի 0 հասցեից, տվյալների սեգմենտը՝ 16 հասցեից, իսկ ստեկի սեգմենտը՝ 24 հասցեից։

«Ստեկային մեքենայի» հրամանները ստորև կներկայացվեն նրա «ասեմբլերի» լեզվով։ Մեքենայի հիշողություն բեռնվելուց հետո, բնականաբար, հրամանները կունենան այլ տեսք։

Ստեկում հաստատուն թիվ կարելի է ավելացնել PUSH հրամանով։ Օրինակ,
PUSH 777  ; ստեկում ավելացնել 777 արժեքը
Որևէ փոփոխականի արժեք ստեկում ավելացնելու համար նույնպես օգտագործվում է PUSH հրամանը՝ արգումենտում ունենալով փոփոխականի իդենտիֆիկատորը։ Փոփոխականների անունները կարող են սկսվել լատինական փոքրատառով և պարունակել միայն փոքրատառեր և թվանշաններ։ Օրինակ,
PUSH a    ; ստեկում ավելացնել a փոփոխականի զբաղեցրած հասցեում գրված արժեքը
PUSH wu3  ; ստեկում ավելացնել wu3 փոփոխականի զբաղեցրած հասցեում գրված արժեքը
Եթե հարկավոր է ստեկում ավելացնել հենց ռեգիստրի պարունակությունը, ապա ստեկի անունը պետք է սկսել «%» նիշով։ ենթադրենք M-ը ստեկային մեքենայի հիշողությունն է։ Այս դեպքում․
PUSH %FP   ; <=> SP := SP + 1; M[SP] := FP
PUSH %SP   ; <=> SPi := SPo + 1; M[SPi] := SPo
Անուղակի հասցեավորում կարելի է կատարել ռեգիստրի արժեքի օգնությամբ։ Օրինակ,
PUSH FP   ; <=> SP := SP + 1; M[SP] := M[FP]
PUSH FP+3 ; <=> SP := SP + 1; M[SP] := M[FP+3]
Այս չորս տիպի PUSH հրամանները կարելի է իրականացնել հետևյալ կերպ։
(defun push-value (value)
  (setf (aref *memory* (incf *sp*)) value))
(defun push-addr (address)
  (push-value (aref *memory* address)))
(defun push-regv (reg)
  (push-value (case reg (0 *ip*) (1 *sp*) (2 *fp*))))
(defun push-reg (reg &optional (disp 0))
  (let ((bs (case reg (0 *ip*) (1 *sp*) (2 *fp*))))
    (push-addr (+ bs disp))))
Ստեկից տվյալներ հեռացնելու համար է նախատեսված POP հրամանը։ Ստեկի գագաթի տարրը որևէ փոփոխականի վերագրելու համար POP հրամանն արգումենտում ունիփոփոխականի անունը։ Օրինակ.
POP u
Ինչպես PUSH հրամանը, նույնպես էլ POP հրամանը կարող է օգտագործել ռեգիստրի արժեքը՝ անուղակի հասցեավորում կազմակերպելու համար։ Օրինակ.
POP FP+1
POP FP
POP FP-12
Նշված երեք տիպի POP հրամաններն էլ իրականացված են հետևյալ ֆունկցիաներով։
(defun pop-value ()
  (aref *memory* (prog1 *sp* (decf *sp*))))
(defun pop-addr (address)
  (setf (aref *memory* address) (pop-value)))
(defun pop-regv (reg)
  (let ((vl (pop-value)))
    (case reg 
      (0 (setf *ip* vl))
      (1 (setf *sp* vl))
      (2 (setf *fp* vl)))))
(defun pop-reg (reg &optional (disp 0))
  (let ((bs (case reg (0 *ip*) (1 *sp*) (2 *fp*))))
    (pop-addr (+ bs disp))))
Օգտագործողի կողմից տվյալները ներմուծվում են IN հրամանով, որը ներմուծած թիվը գրում է ստեկի գագաթում։ Իսկ գործողությունների արդյունքն օգտագործողի համար արտածվում են OUT հրամանով, որը հեռացնում է ստեկի գագթի արժեքը և արտածում է ստանդարտ արտածման հոսքին։ Հետևյալ երկու ֆունկցիաներն այդ հրամանների իրականացումներն են.
(defun input-num ()
  (format t "? ")
  (push-value (parse-integer (read-line))))
(defun output-num ()
  (format t "> ~d~%" (pop-value)))
Ստեկային մեքենայի հրամանների համակարգում նախատեսված են նաև թվաբանական ու համեմատման գործողություններ, ինչպիսիք են գումարում, հանում, հավասարության ստուգում և այլն։ Բայց նախ սահմանենք binary-op և unary-op ֆունկցիաները, որոնց օգնությամբ կսահմանենք կոնկրետ բինար և ունար գործողություններ։
(defun binary-op (operation)
  (let* ((ao (pop-value))
         (ai (pop-value)))
    (push-value (funcall operation ai ao))))
(defun unary-op (operation)
  (let ((ao (pop-value)))
    (push-value (funcall operation ao))))
Հետո նոր սահմանենք ADD, SUB, MUL, DIV, MOD, EQ, NE, GT, GE, LT, LE բինար գործողությունները, ինչպես նաև NEG և NOT ունար գործողությունները։
(defun op-add () (binary-op #'+))
(defun op-sub () (binary-op #'-))
(defun op-mul () (binary-op #'*))
(defun op-div () (binary-op #'/))
(defun op-mod () (binary-op #'rem))
(defun op-eq () (binary-op #'=))
(defun op-ne () (binary-op #'/=))
(defun op-gt () (binary-op #'>))
(defun op-ge () (binary-op #'>=))
(defun op-lt () (binary-op #'<))
(defun op-le () (binary-op #'<=))
(defun op-not () (unary-op #'not))
(defun op-neg () (unary-op #'(lambda (x) (* x -1))))
Մինչև այս պահը թվարկված հրամաններով կարելի է կառուցել միայն գծային ալգորիթմներ։ Որպեսզի հնարավոր լինի ծրագրավորել ճյուղավորվող ու կրկնվող ալգորիթմներ, մեքենան պետք է ունենա անցման հրամաններ։ Ստեկային մեքենայի մոդելում JZ հրամանը անցում է կատարում տրված հասցեով հրամանին, եթե ստեկի գագաթի տարրը զրո է։ Նմանապես JNZ հրամանը անցում է կատարում տրված հասցեով հրամանին, եթե ստեկի գագաթում զրոյից տարբեր արժեք է։ Այս երկու հրամաններն էլ հեռացնում են ստեկի գագաթի տարրը։ Իսկ JUMP հրամանը պարզապես առանց պայմանի անցում է։ Բոլոր երեք հրամաններն էլ փոխում են IP ռեգիստրի արժեքը։
(defun jump (address)
  (setf *ip* address))
(defun jump-true (address)
  (when (pop-value) (jump address)))
(defun jump-false (address)
  (unless (pop-value) (jump address)))
Ասեմբլերային ծրագրի տեքստում նշիչներ (անցման կետեր) սահմանելու համար է LABEL փսևդոհրամանը։ Այն կատարվող հրամանի չի թարգմանվում, պարզապես իր արգումենտում տրված իդենտիֆիկատորին կապում է IP ռեգիստրի ընթացիկ արժեքը՝ հետագա հղումների համար։
LABEL wb0
;...
JUMP wb0
Եվս երկու հրամաններ, որոնք ապահովելու են ֆունկցիայի կանչ և վերադարձ ֆունկցիայից։ CALL հրամանի արգումենտը LABEL փսևդոհրամանով սահմանված իդենտիֆիկատոր է։
(defun call-func (address)
  (push-value 0)       ; ֆունկցիայի վերադարձրած արժեքի տեղը
  (push-value *ip*)    ; վերադարձի հասցեն, IP ռեգիստրի արժեքը
  (push-value *fp*)    ; ստեկի կադրի հին արժեքը
  (setf *fp* *sp*)     ; ստեկի կադրի ընթացիկ արժեքը
  (setf *ip* address)) ; IP ռեգիստրի նոր արժեքը
Ֆունկցիայից վերադարձի համար է նախատեսված RET հրամանը։ Այն տեղափոխում է ստեկի գագաէի տարրը վերադարձվող արժեքի համար նախատեսված տեսը։ վերականգնում է ստեկի ցուցիչի ռգիստրի հին արժեքը և IP ռեգիստրին վերագրում է CALL հրամանի նախատեսած վերադարձի հասցեն։
(defun return-func ()
  (pop-addr (- *fp* 2))    ; վերադարձվող արժեքը
  (setf *fp* (pop-value))  ; ստեկի կադրի ռեգիստրի վերականգնում
  (setf *ip* (pop-value))) ; վերադարձի հասցե

Ամբողջական կոդը տես github կայքում։

Friday, March 22, 2013

Vector to List, Vector to String

Հանդիպեցի մի խնդրի, որտեղ պետք էր Common Lisp վեկտորից (միչափանի զանգված), որի տարրերը (0..255) միջակայքի ամբողջ թվեր են, ստանալ նրա տարրերի ցուցակը և այդ նույն տարրերի տասնվեցական ներկայացումներից բաղկացած տողը։ Օրինակ, վեկտորը կարող է լինել այսպիսին.
(defparameter vec
    #(12 34 210 127 32 7 25 87 193 41 42 200 63 0 137 161))
(print vec)

#(12 34 210 127 32 7 25 87 193 41 42 200 63 0 137 161)
Դե, առաջին միտքն այն էր, որ loop ցիկլով կարելի է անցնել վեկտորի տարրերով և դրանք հավաքել ցուցակի մեջ.
(defparameter veclis
    (loop for e across vec collect e))
(print veclis)

(12 34 210 127 32 7 25 87 193 41 42 200 63 0 137 161)
Իսկ տասնվեցական նիշերից կազմված տողը ստանալու համար կարելի է format ֆունկցիայով ստանալ թվի տասնվեցական ներկայացումը՝ օգտագործելով "~2,'0x" ֆորմատավորման տողը։ Այդ տասնվեցական տեսքերը հավաքել ցուցակի մեջ, ապա այդ ցուցակի նկատմամբ կիրառել concatenate ֆունկցիան, իհարկե, apply ֆունկցիայի միջոցով։
(defparameter vecstr
    (apply #'concatenate 'string 
           (loop for e across vec 
                 collect (format nil "~2,'0x" e))))
(print vecstr)

"0C22D27F20071957C1292AC83F0089A1"
* * *
Բայց, սրանք շատ տգեղ պրոցեդուրային լուծումներ են։ Common Lisp լեզվի reduce ֆունկցիան արգումենտում ստանում է բինար ֆունկցիա և մի որևէ հաջորդականություն, իսկ վերադաձնում է մի արդյունք, որը ստացվում է հաջորդականության բոլոր տարրերի միջև կիրառելով տրված բինար գործողությունը։ Օրինակ, եթե վեկտորը պարունակում է 1-ից 9 թվերը, ապա դրանց գումարը հաշվելու համար կարելի է գրել.
(reduce #'+ 
        #(1 2 3 4 5 6 7 8 9)
        :initial-value 0)
45
Իսկ նույն այդ վեկտորի թվերի քառակուսիների գումարը հաշվելու համար՝
(reduce #'(lambda (a b) (+ a (* b b))) 
        #(1 2 3 4 5 6 7 8 9)
        :initial-value 0)
285
Հիմա, վեկտորից ցուցակ ստանալու համար օգտագործենք (lambda (x y) (cons y x)) ֆունկցիան և '() սկզբնական արժեքը։ reduce ֆունկցիայի արժեքը ստացվում է շրջված տեսքով, դրա համար էլ լրացուցիչ կիրառվել է reverse ֆունկցիան։
(defparameter veclis
    (reverse (reduce #'(lambda (x y) (cons y x)) vec :initial-value '())))
(print veclis)

(12 34 210 127 32 7 25 87 193 41 42 200 63 0 137 161)
Տասնվեցական ներկայացումների տողը ստանալու համար կարելի է օգտագործել (lambda (x y) (format nil "~a~2,'0x" x y)) ֆունկցիան։
(defparameter vecstr
    (reduce #'(lambda (x y)
                (format nil "~a~2,'0x" x y))
            vec :initial-value ""))
(print vecstr)

"0C22D27F20071957C1292AC83F0089A1"

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