cgit.sxemacs.org Git - packages/blob - mule-packages/lookup/lisp/stem-english.el

   1 ;;; stem.el ---- routines for stemming
   2 ;;; $Id: stem-english.el,v 1.1.1.1 1999/04/03 03:02:56 satoru-lookup Exp $
   3
   4 ;;; Author: Tsuchiya Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
   5 ;;; Keywords: stemming
   6
   7 ;;; Commentary:
   8
   9 ;; \e$BO@J8!X\e(BAn algorithm for suffix stripping (M.F.Porter)\e$B!Y$K5-=R$5$l$F\e(B
  10 ;; \e$B$$$k%"%k%4%j%:%`$K4p$E$$$F!"1QC18l$N8lHx$r<h$j=|$/$?$a$N%i%$%V%i%j!#\e(B
  11 ;; \e$BMxMQ5Z$S:FG[I[$N:]$O!"\e(BGNU \e$B0lHL8xMQ5vBz=q$NE,Ev$J%P!<%8%g%s$K$7$?$,$C\e(B
  12 ;; \e$B$F2<$5$$!#\e(B
  13
  14 ;; \e$B0l<!G[I[85\e(B
  15 ;;    http://www-nagao.kuee.kyoto-u.ac.jp/member/tsuchiya/elisp/xdic.html
  16
  17
  18 ;; -*- Emacs-Lisp -*-
  19
  20 (provide 'stem)
  21
  22 (defvar stem:minimum-word-length 4 "Porter \e$B$N%"%k%4%j%:%`$,E,MQ$G$-$k:G>.8lD9\e(B")
  23
  24
  25 ;;;============================================================
  26 ;;;     \e$BHs8x3+4X?t\e(B
  27 ;;;============================================================
  28
  29 ;; \e$BF0:nB.EY$r8~>e$5$;$k$?$a$K!"4X?tFbIt$G30ItJQ?t$r$$$8$C$F$$$k\e(B
  30 ;; \e$B4X?t$,$"$j!"M=4|$7$J$$I{:nMQ$,H/@8$9$k2DG=@-$,9b$$!#=>$C$F!"\e(B
  31 ;; \e$BHs8x3+4X?t$rD>@\8F$S=P$9$3$H$OHr$1$k$3$H!#\e(B
  32
  33 ;;------------------------------------------------------------
  34 ;;      stemming-rule \e$B$N>r7o@a$r5-=R$9$k4X?t72\e(B
  35 ;;------------------------------------------------------------
  36
  37 (defsubst stem:match (arg) "\
  38 \e$BJQ?t\e(B str \e$B$r8!::$9$kHs8x3+4X?t\e(B (\e$B8l44$NItJ,$rJQ?t\e(B stem \e$B$KBeF~$9$k\e(B)"
  39   (and
  40    (string-match arg str)
  41    (setq stem (substring str 0 (match-beginning 0)))))
  42
  43 (defsubst stem:m () "\
  44 \e$BJQ?t\e(B stem \e$B$K4^$^$l$F$$$k\e(B VC \e$B$N?t$r5a$a$kHs8x3+4X?t\e(B"
  45   (save-match-data
  46     (let ((pos 0)(m 0))
  47       (while (string-match "\\(a\\|e\\|i\\|o\\|u\\|[^aeiou]y+\\)[aeiou]*" stem pos)
  48         (setq m (1+ m))
  49         (setq pos (match-end 0)))
  50       (if (= pos (length stem)) (1- m) m))))
  51
  52 (defsubst stem:m> (i) "\
  53 \e$BJQ?t\e(B stem \e$B$K4^$^$l$F$$$k\e(B VC \e$B$N?t$N>r7o$r5-=R$9$kHs8x3+4X?t\e(B"
  54   (< i (stem:m)))
  55
  56 (defsubst stem:m= (i) "\
  57 \e$BJQ?t\e(B stem \e$B$K4^$^$l$F$$$k\e(B VC \e$B$N?t$N>r7o$r5-=R$9$kHs8x3+4X?t\e(B"
  58   (= i (stem:m)))
  59
  60 (defsubst stem:*v* () "\
  61 \e$BJQ?t\e(B stem \e$B$,Jl2;$r4^$s$G$$$k$+8!::$9$k4X?t\e(B"
  62   (save-match-data
  63     (if (string-match "\\(a\\|e\\|i\\|o\\|u\\|[^aeiou]y\\)" stem) t)))
  64
  65 (defsubst stem:*o () "\
  66 \e$BJQ?t\e(B stem \e$B$,\e(B cvc \e$B$N7A$G=*$C$F$$$k$+8!::$9$k4X?t\e(B"
  67   (save-match-data
  68     (if (string-match "[^aeiou][aeiouy][^aeiouwxy]$" stem) t)))
  69
  70
  71
  72 ;;------------------------------------------------------------
  73 ;;      stemming-rule \e$B$r5-=R$7$?4X?t72\e(B
  74 ;;------------------------------------------------------------
  75
  76 (defun stem:step1a (str) "\e$BBh\e(B1a\e$BCJ3,$N\e(B stemming rule (\e$BHs8x3+4X?t\e(B)"
  77   (let ((s)(stem))
  78     (if (setq s (cond
  79                  ((stem:match "sses$") "ss")
  80                  ((stem:match "ies$")  "i")
  81                  ((stem:match "ss$")   "ss")
  82                  ((stem:match "s$")    "")))
  83         (concat stem s)
  84       str)))
  85
  86
  87 (defun stem:step1b (str) "\e$BBh\e(B1b\e$BCJ3,$N\e(B stemming rule (\e$BHs8x3+4X?t\e(B)"
  88   (let ((s)(stem))
  89     (cond
  90      ((and (stem:match "eed$") (stem:m> 0))
  91       (concat stem "ee"))
  92      ((or (and (not stem) (stem:match "ed$") (stem:*v*))
  93           (and (stem:match "ing$") (stem:*v*)))
  94       (if (and (stem:m= 1) (stem:*o))
  95           (concat stem "e")
  96         (setq str stem)
  97         (if (setq s (cond
  98                      ((stem:match "at$") "ate")
  99                      ((stem:match "bl$") "ble")
 100                      ((stem:match "iz$") "ize")
 101                      ((stem:match "\\([^lsz]\\)\\1$")
 102                       (substring str (match-beginning 1) (match-end 1)))))
 103             (concat stem s)
 104           str)))
 105      (t str))))
 106
 107
 108 (defun stem:step1c (str) "\e$BBh\e(B1c\e$BCJ3,$N\e(B stemming rule (\e$BHs8x3+4X?t\e(B)"
 109   (let ((stem))
 110     (if (and (stem:match "y$")
 111              (stem:*v*))
 112         (concat stem "i")
 113       str)))
 114
 115
 116 (defun stem:step1 (str) "\e$BBh\e(B1\e$BCJ3,$N\e(B stemming rule (\e$BHs8x3+4X?t\e(B)"
 117   (stem:step1c
 118    (stem:step1b
 119     (stem:step1a str))))
 120
 121
 122 (defun stem:step2 (str) "\e$BBh\e(B2\e$BCJ3,$N\e(B stemming rule (\e$BHs8x3+4X?t\e(B)"
 123   (let ((s)(stem))
 124     (if (and
 125          (setq s (cond
 126                   ((stem:match "ational$") "ate")
 127                   ((stem:match "tional$")  "tion")
 128                   ((stem:match "enci$")    "ence")
 129                   ((stem:match "anci$")    "ance")
 130                   ((stem:match "izer$")    "ize")
 131                   ((stem:match "abli$")    "able")
 132                   ((stem:match "alli$")    "al")
 133                   ((stem:match "entli$")   "ent")
 134                   ((stem:match "eli$")     "e")
 135                   ((stem:match "ousli$")   "ous")
 136                   ((stem:match "ization$") "ize")
 137                   ((stem:match "ation$")   "ate")
 138                   ((stem:match "ator$")    "ate")
 139                   ((stem:match "alism$")   "al")
 140                   ((stem:match "iveness$") "ive")
 141                   ((stem:match "fulness$") "ful")
 142                   ((stem:match "ousness$") "ous")
 143                   ((stem:match "aliti$")   "al")
 144                   ((stem:match "iviti$")   "ive")
 145                   ((stem:match "biliti$")  "ble")))
 146          (stem:m> 0))
 147         (concat stem s)
 148       str)))
 149
 150
 151 (defun stem:step3 (str) "\e$BBh\e(B3\e$BCJ3,$N\e(B stemming rule (\e$BHs8x3+4X?t\e(B)"
 152   (let ((s)(stem))
 153     (if (and
 154          (setq s (cond
 155                   ((stem:match "icate$") "ic")
 156                   ((stem:match "ative$") "")
 157                   ((stem:match "alize$") "al")
 158                   ((stem:match "iciti$") "ic")
 159                   ((stem:match "ical$")  "ic")
 160                   ((stem:match "ful$")   "")
 161                   ((stem:match "ness$")  "")))
 162          (stem:m> 0))
 163         (concat stem s)
 164       str)))
 165
 166
 167 (defun stem:step4 (str) "\e$BBh\e(B4\e$BCJ3,$N\e(B stemming rule (\e$BHs8x3+4X?t\e(B)"
 168   (let ((stem))
 169     (if (and (or
 170               (stem:match "al$")
 171               (stem:match "ance$")
 172               (stem:match "ence$")
 173               (stem:match "er$")
 174               (stem:match "ic$")
 175               (stem:match "able$")
 176               (stem:match "ible$")
 177               (stem:match "ant$")
 178               (stem:match "ement$")
 179               (stem:match "ment$")
 180               (stem:match "ent$")
 181               (and (string-match "[st]\\(ion\\)$" str)
 182                    (setq stem (substring str 0 (match-beginning 1))))
 183               (stem:match "ou$")
 184               (stem:match "ism$")
 185               (stem:match "ate$")
 186               (stem:match "iti$")
 187               (stem:match "ous$")
 188               (stem:match "ive$")
 189               (stem:match "ize$"))
 190              (stem:m> 1))
 191         stem str)))
 192
 193
 194 (defun stem:step5 (str) "\e$BBh\e(B5\e$BCJ3,$N\e(B stemming rule (\e$BHs8x3+4X?t\e(B)"
 195   (let ((stem))
 196     (if (or
 197          (and (stem:match "e$")
 198               (or (stem:m> 1)
 199                   (and (stem:m= 1)
 200                        (not (stem:*o)))))
 201          (and (stem:match "ll$")
 202               (setq stem (concat stem "l"))
 203               (stem:m> 1)))
 204         stem str)))
 205
 206
 207 (defvar stem:irregular-verb-alist
 208   '(("abode" "abide")
 209     ("abided" "abide")
 210     ("alighted" "alight")
 211     ("arose" "arise")
 212     ("arisen" "arise")
 213     ("awoke" "awake")
 214     ("awaked" "awake")
 215     ("awoken" "awake")
 216     ("baby-sat" "baby-sit")
 217     ("backbit" "backbite")
 218     ("backbitten" "backbite")
 219     ("backslid" "backslide")
 220     ("backslidden" "backslide")
 221     ("was" "be" "am" "is" "are")
 222     ("were" "be" "am" "is" "are")
 223     ("been" "be" "am" "is" "are")
 224     ("bore" "bear")
 225     ("bare" "bear")
 226     ("borne" "bear")
 227     ("born" "bear")
 228     ("beat" "beat")
 229     ("beaten" "beat")
 230     ("befell" "befall")
 231     ("befallen" "befall")
 232     ("begot" "beget")
 233     ("begat" "beget")
 234     ("begotten" "beget")
 235     ("began" "begin")
 236     ("begun" "begin")
 237     ("begirt" "begird")
 238     ("begirded" "begird")
 239     ("beheld" "behold")
 240     ("bent" "bend")
 241     ("bended" "bend")
 242     ("bereaved" "bereave")
 243     ("bereft" "bereave")
 244     ("besought" "beseech")
 245     ("beseeched" "beseech")
 246     ("beset" "beset")
 247     ("bespoke" "bespeak")
 248     ("bespoken" "bespeak")
 249     ("bestrewed" "bestrew")
 250     ("bestrewn" "bestrew")
 251     ("bestrode" "bestride")
 252     ("bestrid" "bestride")
 253     ("bestridden" "bestride")
 254     ("bet" "bet")
 255     ("betted" "bet")
 256     ("betook" "betake")
 257     ("betaken" "betake")
 258     ("bethought" "bethink")
 259     ("bade" "bid")
 260     ("bid" "bid")
 261     ("bad" "bid")
 262     ("bedden" "bid")
 263     ("bided" "bide")
 264     ("bode" "bide")
 265     ("bound" "bind")
 266     ("bit" "bite")
 267     ("bitten" "bite")
 268     ("bled" "bleed")
 269     ("blended" "blend")
 270     ("blent" "blend")
 271     ("blessed" "bless")
 272     ("blest" "bless")
 273     ("blew" "blow")
 274     ("blown" "blow")
 275     ("blowed" "blow")
 276     ("bottle-fed" "bottle-feed")
 277     ("broke" "break")
 278     ("broken" "break")
 279     ("breast-fed" "breast-feed")
 280     ("bred" "breed")
 281     ("brought" "bring")
 282     ("broadcast" "broadcast")
 283     ("broadcasted" "broadcast")
 284     ("browbeat" "browbeat")
 285     ("browbeaten" "browbeat")
 286     ("built" "build")
 287     ("builded" "build")
 288     ("burned" "burn")
 289     ("burnt" "burn")
 290     ("burst" "burst")
 291     ("busted" "bust")
 292     ("bust" "bust")
 293     ("bought" "buy")
 294     ("cast" "cast")
 295     ("chid" "chide")
 296     ("chided" "chide")
 297     ("chidden" "chide")
 298     ("chose" "choose")
 299     ("chosen" "choose")
 300     ("clove" "cleave")
 301     ("cleft" "cleave")
 302     ("cleaved" "cleave")
 303     ("cloven" "cleave")
 304     ("clave" "cleave")
 305     ("clung" "cling")
 306     ("clothed" "clothe")
 307     ("clad" "clothe")
 308     ("colorcast" "colorcast")
 309     ("clorcasted" "colorcast")
 310     ("came" "come")
 311     ("come" "come")
 312     ("cost" "cost")
 313     ("costed" "cost")
 314     ("countersank" "countersink")
 315     ("countersunk" "countersink")
 316     ("crept" "creep")
 317     ("crossbred" "crossbreed")
 318     ("crowed" "crow")
 319     ("crew" "crow")
 320     ("cursed" "curse")
 321     ("curst" "curse")
 322     ("cut" "cut")
 323     ("dared" "dare")
 324     ("durst" "dare")
 325     ("dealt" "deal")
 326     ("deep-froze" "deep-freeze")
 327     ("deep-freezed" "deep-freeze")
 328     ("deep-frozen" "deep-freeze")
 329     ("dug" "dig")
 330     ("digged" "dig")
 331     ("dived" "dive")
 332     ("dove" "dive")
 333     ("did" "do")
 334     ("done" "do")
 335     ("drew" "draw")
 336     ("drawn" "draw")
 337     ("dreamed" "dream")
 338     ("dreamt" "dream")
 339     ("drank" "drink")
 340     ("drunk" "drink")
 341     ("dripped" "drip")
 342     ("dript" "drip")
 343     ("drove" "drive")
 344     ("drave" "drive")
 345     ("driven" "drive")
 346     ("dropped" "drop")
 347     ("dropt" "drop")
 348     ("dwelt" "dwell")
 349     ("dwelled" "dwell")
 350     ("ate" "eat")
 351     ("eaten" "eat")
 352     ("fell" "fall")
 353     ("fallen" "fall")
 354     ("fed" "feed")
 355     ("felt" "feel")
 356     ("fought" "fight")
 357     ("found" "find")
 358     ("fled" "fly" "flee")
 359     ("flung" "fling")
 360     ("flew" "fly")
 361     ("flied" "fly")
 362     ("flown" "fly")
 363     ("forbore" "forbear")
 364     ("forborne" "forbear")
 365     ("forbade" "forbid")
 366     ("forbad" "forbid")
 367     ("forbidden" "forbid")
 368     ("forecast" "forecast")
 369     ("forecasted" "forecast")
 370     ("forewent" "forego")
 371     ("foregone" "forego")
 372     ("foreknew" "foreknow")
 373     ("foreknown" "foreknow")
 374     ("foreran" "forerun")
 375     ("forerun" "forerun")
 376     ("foresaw" "foresee")
 377     ("foreseen" "foresee")
 378     ("foreshowed" "foreshow")
 379     ("foreshown" "foreshow")
 380     ("foretold" "foretell")
 381     ("forgot" "forget")
 382     ("forgotten" "forget")
 383     ("forgave" "forgive")
 384     ("forgiven" "forgive")
 385     ("forwent" "forgo")
 386     ("forgone" "forgo")
 387     ("forsook" "forsake")
 388     ("forsaken" "forsake")
 389     ("forswore" "forswear")
 390     ("forsworn" "forswear")
 391     ("froze" "freeze")
 392     ("frozen" "freeze")
 393     ("gainsaid" "gainsay")
 394     ("gelded" "geld")
 395     ("gelt" "geld")
 396     ("got" "get")
 397     ("gotten" "get")
 398     ("ghostwrote" "ghostwrite")
 399     ("ghostwritten" "ghostwrite")
 400     ("gilded" "gild")
 401     ("gilt" "gild")
 402     ("girded" "gird")
 403     ("girt" "gird")
 404     ("gave" "give")
 405     ("given" "give")
 406     ("gnawed" "gnaw")
 407     ("gnawn" "gnaw")
 408     ("went" "wend" "go")
 409     ("gone" "go")
 410     ("graved" "grave")
 411     ("graven" "grave")
 412     ("ground" "grind")
 413     ("gripped" "grip")
 414     ("gript" "grip")
 415     ("grew" "grow")
 416     ("grown" "grow")
 417     ("hamstrung" "hamstring")
 418     ("hamstringed" "hamstring")
 419     ("hung" "hang")
 420     ("hanged" "hang")
 421     ("had" "have")
 422     ("heard" "hear")
 423     ("heaved" "heave")
 424     ("hove" "heave")
 425     ("hewed" "hew")
 426     ("hewn" "hew")
 427     ("hid" "hide")
 428     ("hidden" "hide")
 429     ("hit" "hit")
 430     ("held" "hold")
 431     ("hurt" "hurt")
 432     ("indwelt" "indwell")
 433     ("inlaid" "inlay")
 434     ("inlet" "inlet")
 435     ("inputted" "input")
 436     ("input" "input")
 437     ("inset" "inset")
 438     ("insetted" "inset")
 439     ("interwove" "interweave")
 440     ("interweaved" "interweave")
 441     ("jigsawed" "jigsaw")
 442     ("jigsawn" "jigsaw")
 443     ("kept" "keep")
 444     ("knelt" "kneel")
 445     ("kneeled" "kneel")
 446     ("knitted" "knit")
 447     ("knit" "knit")
 448     ("knew" "know")
 449     ("known" "know")
 450     ("laded" "lade")
 451     ("laden" "lade")
 452     ("laid" "lay")
 453     ("led" "lead")
 454     ("leaned" "lean")
 455     ("leant" "lean")
 456     ("leaped" "leap")
 457     ("leapt" "leap")
 458     ("learned" "learn")
 459     ("learnt" "learn")
 460     ("left" "leave")
 461     ("lent" "lend")
 462     ("let" "let")
 463     ("lay" "lie")
 464     ("lain" "lie")
 465     ("lighted" "light")
 466     ("lit" "light")
 467     ("lip-read" "lip-read")
 468     ("lost" "lose")
 469     ("made" "make")
 470     ("meant" "mean")
 471     ("met" "meet")
 472     ("melted" "melt")
 473     ("methougt" "methinks")
 474     ;; ("-" "methinks")
 475     ("misbecame" "misbecome")
 476     ("misbecome" "misbecome")
 477     ("miscast" "miscast")
 478     ("miscasted" "miscast")
 479     ("misdealt" "misdeal")
 480     ("misdid" "misdo")
 481     ("misdone" "misdo")
 482     ("misgave" "misgive")
 483     ("misgiven" "misgive")
 484     ("mishit" "mishit")
 485     ("mislaid" "mislay")
 486     ("misled" "mislead")
 487     ("misread" "misread")
 488     ("misspelt" "misspell")
 489     ("missplled" "misspell")
 490     ("misspent" "misspend")
 491     ("mistook" "mistake")
 492     ("mistaken" "mistake")
 493     ("misunderstood" "misunderstand")
 494     ("mowed" "mow")
 495     ("mown" "mow")
 496     ("offset" "offset")
 497     ("outbid" "outbid")
 498     ("outbade" "outbid")
 499     ("outbidden" "outbid")
 500     ("outdid" "outdo")
 501     ("outdone" "outdo")
 502     ("outfought" "outfight")
 503     ("outgrew" "outgrown")
 504     ("outgrown" "outgrown")
 505     ("outlaid" "outlay")
 506     ("output" "output")
 507     ("outputted" "output")
 508     ("ooutputted" "output")
 509     ("outrode" "outride")
 510     ("outridden" "outride")
 511     ("outran" "outrun")
 512     ("outrun" "outrun")
 513     ("outsold" "outsell")
 514     ("outshone" "outshine")
 515     ("outshot" "outshoot")
 516     ("outwore" "outwear")
 517     ("outworn" "outwear")
 518     ("overbore" "overbear")
 519     ("overborne" "overbear")
 520     ("overbid" "overbid")
 521     ("overblew" "overblow")
 522     ("overblown" "overblow")
 523     ("overcame" "overcome")
 524     ("overcome" "overcome")
 525     ("overdid" "overdo")
 526     ("overdone" "overdo")
 527     ("overdrew" "overdraw")
 528     ("overdrawn" "overdraw")
 529     ("overdrank" "overdrink")
 530     ("overdrunk" "overdrink")
 531     ("overate" "overeat")
 532     ("overeaten" "overeat")
 533     ("overfed" "overfeed")
 534     ("overflowed" "overflow")
 535     ("overflown" "overfly" "overflow")
 536     ("overflew" "overfly")
 537     ("overgrew" "overgrow")
 538     ("overgrown" "overgrow")
 539     ("overhung" "overhang")
 540     ("overhanged" "overhang")
 541     ("ovearheard" "overhear")
 542     ("overlaid" "overlay")
 543     ("overleaped" "overleap")
 544     ("overleapt" "overleap")
 545     ("overlay" "overlie")
 546     ("overlain" "overlie")
 547     ("overpaid" "overpay")
 548     ("overrode" "override")
 549     ("overridden" "override")
 550     ("overran" "overrun")
 551     ("overrun" "overrun")
 552     ("oversaw" "oversee")
 553     ("overseen" "oversee")
 554     ("oversold" "oversell")
 555     ("overset" "overset")
 556     ("overshot" "overshoot")
 557     ("overspent" "overspend")
 558     ("overspread" "overspread")
 559     ("overtook" "overtake")
 560     ("overtaken" "overtake")
 561     ("overthrew" "overthrow")
 562     ("overthrown" "overthrow")
 563     ("overworked" "overwork")
 564     ("overwrought" "overwork")
 565     ("partook" "partake")
 566     ("partaken" "partake")
 567     ("paid" "pay")
 568     ("penned" "pen")
 569     ("pent" "pen")
 570     ("pinch-hit" "pinch-hit")
 571     ("pleaded" "plead")
 572     ("plead" "plead")
 573     ("pled" "plead")
 574     ("prepaid" "prepay")
 575     ("preset" "preset")
 576     ("proofread" "proofread")
 577     ("proved" "prove")
 578     ("proven" "prove")
 579     ("put" "put")
 580     ("quick-froze" "quick-freeze")
 581     ("quick-frozen" "quick-freeze")
 582     ("quit" "quit")
 583     ("quitted" "quit")
 584     ("read" "read")
 585     ("reaved" "reave")
 586     ("reft" "reave")
 587     ("rebound" "rebind")
 588     ("rebroadcast" "rebroadcast")
 589     ("rebroadcasted" "rebroadcast")
 590     ("rebuilt" "rebuild")
 591     ("recast" "recast")
 592     ("recasted" "recast")
 593     ("re-did" "re-do")
 594     ("re-done" "re-do")
 595     ("reeved" "reeve")
 596     ("rove" "reeve")
 597     ("reheard" "rehear")
 598     ("relaid" "relay")
 599     ("remade" "remake")
 600     ("rent" "rend")
 601     ("repaid" "repay")
 602     ("reread" "reread")
 603     ("reran" "rerun")
 604     ("rerun" "rerun")
 605     ("resold" "resell")
 606     ("reset" "reset")
 607     ("retook" "retake")
 608     ("retaken" "retake")
 609     ("retold" "retell")
 610     ("rethought" "rethink")
 611     ("rewound" "rewind")
 612     ("rewinded" "rewind")
 613     ("rewrote" "rewrite")
 614     ("rewritten" "rewrite")
 615     ("rid" "ride") ;; ("rid" "ride" "rid")
 616     ("ridded" "rid")
 617     ("rode" "ride")
 618     ("ridden" "ride")
 619     ("rang" "ring")
 620     ("rung" "ring")
 621     ("rose" "rise")
 622     ("risen" "rise")
 623     ("rived" "rive")
 624     ("riven" "rive")
 625     ("roughcast" "roughcast")
 626     ("roughhewed" "roughhew")
 627     ("roughhewn" "roughhew")
 628     ("ran" "run")
 629     ("run" "run")
 630     ("sawed" "saw")
 631     ("sawn" "saw")
 632     ("said" "say")
 633     ("saw" "see")
 634     ("seen" "see")
 635     ("sought" "seek")
 636     ("sold" "sell")
 637     ("sent" "send")
 638     ("set" "set")
 639     ("sewed" "sew")
 640     ("sewn" "sew")
 641     ("shook" "shake")
 642     ("shaken" "shake")
 643     ("shaved" "shave")
 644     ("shaven" "shave")
 645     ("sheared" "shear")
 646     ("shore" "shear")
 647     ("shorn" "shear")
 648     ("shed" "shed")
 649     ("shone" "shine")
 650     ("shined" "shine")
 651     ("shit" "shit")
 652     ("shat" "shit")
 653     ("shitted" "shit")
 654     ("shod" "shoe")
 655     ("shoed" "shoe")
 656     ("shot" "shoot")
 657     ("showed" "show")
 658     ("shown" "show")
 659     ("shredded" "shred")
 660     ("shred" "shred")
 661     ("shrank" "shrink")
 662     ("shrunk" "shrink")
 663     ("shrunken" "shrink")
 664     ("shrived" "shrive")
 665     ("shrove" "shrive")
 666     ("shriven" "shrive")
 667     ("shut" "shut")
 668     ("sight-read" "sight-read")
 669     ("simulcast" "simulcast")
 670     ("simulcasted" "simulcast")
 671     ("sang" "sing")
 672     ("sung" "sing")
 673     ("sank" "sink")
 674     ("sunk" "sink")
 675     ("sunken" "sink")
 676     ("sat" "sit")
 677     ("sate" "sit")
 678     ("slew" "slay")
 679     ("slain" "slay")
 680     ("slept" "sleep")
 681     ("slid" "slide")
 682     ("slidden" "slide")
 683     ("slunk" "slink")
 684     ("smelled" "smell")
 685     ("smelt" "smell")
 686     ("smote" "smite")
 687     ("smitten" "smite")
 688     ("smit" "smite")
 689     ("sowed" "sow")
 690     ("sown" "sow")
 691     ("spoke" "speak")
 692     ("spoken" "speak")
 693     ("sped" "speed")
 694     ("speeded" "speed")
 695     ("spelled" "spell")
 696     ("spelt" "spell")
 697     ("spellbound" "spellbind")
 698     ("spent" "spend")
 699     ("spilled" "spill")
 700     ("spilt" "spill")
 701     ("spun" "spin")
 702     ("span" "spin")
 703     ("spat" "spit")
 704     ("spit" "spit")
 705     ("split" "split")
 706     ("spoiled" "spoil")
 707     ("spoilt" "spoil")
 708     ("spoon-fed" "spoon-feed")
 709     ("spread" "spread")
 710     ("sprang" "spring")
 711     ("sprung" "spring")
 712     ("stood" "stand")
 713     ("staved" "stave")
 714     ("stove" "stave")
 715     ("stayed" "stay")
 716     ("staid" "stay")
 717     ("stole" "steal")
 718     ("stolen" "steal")
 719     ("stuck" "stick")
 720     ("stung" "sting")
 721     ("stank" "stink")
 722     ("stunk" "stink")
 723     ("strewed" "strew")
 724     ("strewn" "strew")
 725     ("strode" "stride")
 726     ("stridden" "stride")
 727     ("struck" "strike")
 728     ("stricken" "strike")
 729     ("strung" "string")
 730     ("strove" "strive")
 731     ("striven" "strive")
 732     ("sublet" "sublet")
 733     ("sunburned" "sunburn")
 734     ("sunburnt" "sunburn")
 735     ("swore" "swear")
 736     ("sware" "swear")
 737     ("sworn" "swear")
 738     ("sweat" "sweat")
 739     ("sweated" "sweat")
 740     ("swept" "sweep")
 741     ("swelled" "swell")
 742     ("swollen" "swell")
 743     ("swam" "swim")
 744     ("swum" "swim")
 745     ("swung" "swing")
 746     ("took" "take")
 747     ("taken" "take")
 748     ("taught" "teach")
 749     ("tore" "tear")
 750     ("torn" "tear")
 751     ("telecast" "telecast")
 752     ("telecasted" "telecast")
 753     ("told" "tell")
 754     ("thought" "think")
 755     ("thrived" "thrive")
 756     ("throve" "thrive")
 757     ("thriven" "thrive")
 758     ("threw" "thrown")
 759     ("thrown" "thrown")
 760     ("thrust" "thrust")
 761     ("tossed" "toss")
 762     ("tost" "toss")
 763     ("trod" "tread")
 764     ("treaded" "tread")
 765     ("trode" "tread")
 766     ("trodden" "tread")
 767     ("typecast" "typecast")
 768     ("typewrote" "typewrite")
 769     ("typewritten" "typewrite")
 770     ("unbent" "unbend")
 771     ("unbended" "unbend")
 772     ("unbound" "unbind")
 773     ("underbid" "underbid")
 774     ("underbidden" "underbid")
 775     ("undercut" "undercut")
 776     ("underwent" "undergo")
 777     ("undergone" "undergo")
 778     ("underlaid" "underlay")
 779     ("underlay" "underlie")
 780     ("underlain" "underlie")
 781     ("underpaid" "underpay")
 782     ("undersold" "undersell")
 783     ("undershot" "undershoot")
 784     ("understood" "understand")
 785     ("undertook" "undertake")
 786     ("undertaken" "undertake")
 787     ("underwrote" "underwrite")
 788     ("underwritten" "underwrite")
 789     ("undid" "undo")
 790     ("undone" "undo")
 791     ("undrew" "undraw")
 792     ("undrawn" "undraw")
 793     ("ungirded" "ungird")
 794     ("ungirt" "ungird")
 795     ("unlearnt" "unlearn")
 796     ("unlearned" "unlearn")
 797     ("unmade" "unmake")
 798     ("unsaid" "unsay")
 799     ("unstuck" "unstick")
 800     ("unstrung" "unstring")
 801     ("unwound" "unwind")
 802     ("upheld" "uphold")
 803     ("uprose" "uprise")
 804     ("uprisen" "uprise")
 805     ("upset" "upset")
 806     ("upswept" "upsweep")
 807     ("woke" "wake")
 808     ("waked" "wake")
 809     ("woken" "wake")
 810     ("waylaid" "waylay")
 811     ("wore" "wear")
 812     ("worn" "wear")
 813     ("wove" "weave")
 814     ("weaved" "weave")
 815     ("woven" "weave")
 816     ("wed" "wed")
 817     ("wedded" "wed")
 818     ("wept" "weep")
 819     ("wended" "wend")
 820     ("wetted" "wet")
 821     ("wet" "wet")
 822     ("won" "win")
 823     ("wound" "wind")
 824     ("winded" "wind")
 825     ("wiredrew" "wiredraw")
 826     ("wiredrawn" "wiredraw")
 827     ("wist" "wit")
 828     ("withdrew" "withdraw")
 829     ("withdrawn" "withdraw")
 830     ("withheld" "withhold")
 831     ("withstood" "withstand")
 832     ("worked" "work")
 833     ("wrought" "work")
 834     ("wrapped" "wrap")
 835     ("wrapt" "wrap")
 836     ("wrung" "wring")
 837     ("wrote" "write")
 838     ("writ" "write")
 839     ("written" "write"))
 840   "\e$BIT5,B'F0;l$H867A$NO"A[G[Ns\e(B")
 841
 842
 843 (defun stem:extra (str) "\
 844 \e$BF0;l\e(B/\e$B7AMF;l$N3hMQ7A$HL>;l$NJ#?t7A$N3hMQ8lHx$r<h$j=|$/Hs8x3+4X?t\e(B
 845 \e$BM?$($i$l$?8l$N867A$H$7$F2DG=@-$N$"$k8l$N%j%9%H$rJV$9\e(B"
 846   (or (assoc str stem:irregular-verb-alist)
 847       (let (c l stem)
 848         (setq l (cond
 849                  ;; \e$BHf3S5i\e(B/\e$B:G>e5i\e(B
 850                  ((stem:match "\\([^aeiou]\\)\\1e\\(r\\|st\\)$")
 851                   (list (substring str (match-beginning 1) (match-end 1))
 852                         (substring str (match-beginning 0) (match-beginning 2))))
 853                  ((stem:match "\\([^aeiou]\\)ie\\(r\\|st\\)$")
 854                   (setq c (substring str (match-beginning 1) (match-end 1)))
 855                   (list c (concat c "y") (concat c "ie")))
 856                  ((stem:match "e\\(r\\|st\\)$") '("" "e"))
 857                  ;; 3\e$BC18=\e(B/\e$BJ#?t7A\e(B
 858                  ((stem:match "ches$") '("ch" "che"))
 859                  ((stem:match "shes$") '("sh" "che"))
 860                  ((stem:match "ses$") '("s" "se"))
 861                  ((stem:match "xes$") '("x" "xe"))
 862                  ((stem:match "zes$") '("z" "ze"))
 863                  ((stem:match "ves$") '("f" "fe"))
 864                  ((stem:match "\\([^aeiou]\\)oes$")
 865                   (setq c (substring str -4 -3))
 866                   (list c (concat c "o") (concat c "oe")))
 867                  ((stem:match "\\([^aeiou]\\)ies$")
 868                   (setq c (substring str -4 -3))
 869                   (list c (concat c "y") (concat c "ie")))
 870                  ((stem:match "es$") '("" "e"))
 871                  ((stem:match "s$") '(""))
 872                  ;; \e$B2a5n7A\e(B/\e$B2a5nJ,;l\e(B
 873                  ((stem:match "\\([^aeiou]\\)ied$")
 874                   (setq c (substring str -4 -3))
 875                   (list c (concat c "y") (concat c "ie")))
 876                  ((stem:match "\\([^aeiou]\\)\\1ed$")
 877                   (list (substring str -4 -3)
 878                         (substring str -4 -1)))
 879                  ((stem:match "cked$") '("c" "cke"))
 880                  ((stem:match "ed$") '("" "e"))
 881                  ;; \e$B8=:_J,;l\e(B
 882                  ((stem:match "\\([^aeiou]\\)\\1ing$")
 883                   (list (substring str -5 -4)))
 884                  ((stem:match "ing$") '("" "e"))
 885                  ))
 886         (append (mapcar '(lambda (s) (concat stem s)) l)
 887                 (list str))
 888         )))
 889
 890
 891
 892 ;;;============================================================
 893 ;;;     \e$B8x3+4X?t\e(B
 894 ;;;============================================================
 895
 896 (defun stem:stripping-suffix (str) "\
 897 \e$B3hMQ8lHx$r<h$j=|$/4X?t\e(B
 898 \e$BM?$($i$l$?8l$N85$N8l$H$7$F2DG=@-$N$"$k8l$N<-=q=g$N%j%9%H$rJV$9\e(B"
 899   (save-match-data
 900     (delq nil (let ((w ""))
 901                 (mapcar
 902                  (function (lambda (x) (if (string= x w) nil (setq w x))))
 903                  (sort (append
 904                         ;; \e$BBgJ8;z$r>.J8;z$KJQ49\e(B
 905                         (list (prog1 str (setq str (downcase str))))
 906                         ;; \e$BFH<+$N%R%e!<%j%9%F%#%C%/%9$rE,MQ\e(B
 907                         (stem:extra str)
 908                         (if (> (length str) stem:minimum-word-length)
 909                             ;; \e$BC18lD9$,>r7o$rK~$?$;$P!"\e(BPorter \e$B$N%"%k%4%j%:%`$rE,MQ\e(B
 910                             (mapcar
 911                              '(lambda (func)
 912                                 (setq str (funcall func str)))
 913                              '(stem:step1 stem:step2 stem:step3 stem:step4 stem:step5))))
 914                        'string<))))))
 915
 916
 917 ;;;###autoload
 918 (defun stem-english (str) "\
 919 \e$B3hMQ8lHx$r<h$j=|$/4X?t\e(B
 920 \e$BM?$($i$l$?8l$N85$N8l$H$7$F2DG=@-$N$"$k8l$NJ8;zNsD9$N>:=g$N%j%9%H$rJV$9\e(B"
 921   (sort (stem:stripping-suffix str)
 922         (function (lambda (a b) (< (length a) (length b))))))
 923
 924 ;; \e$B$3$N\e(B stem-english \e$B$NF0:n$O!"\e(B
 925 ;;
 926 ;;     Id: stem.el,v 1.4 1998/11/30 09:27:27 tsuchiya Exp tsuchiya
 927 ;;
 928 ;; \e$B0JA0$N%P!<%8%g%s$N\e(B stem.el \e$B$GDj5A$5$l$F$$$?\e(B stem:stripping-suffix
 929 ;; \e$B$NF0:n$H8_49$G$"$k!#8=:_$N\e(B stem:stripping-suffix \e$B$O<-=q=g$N%j%9%H$r\e(B
 930 ;; \e$BJV$9$?$a!"0[$J$kF0:n$H$9$k$h$&$K$J$C$F$$$k$N$GCm0U$9$k$3$H!#\e(B
 931
 932
 933 ;;; Porter \e$B$N%"%k%4%j%:%`$rE,MQ$9$k4X?t\e(B
 934 (defun stem:stripping-inflection (word) "\
 935 Porter \e$B$N%"%k%4%j%:%`$K4p$E$$$FGI@88l$r=hM}$9$k4X?t\e(B"
 936   (save-match-data
 937     (stem:step5
 938      (stem:step4
 939       (stem:step3
 940        (stem:step2
 941         (stem:step1 word)))))))