home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1999 April / VPR9904A.BIN / Vpr_data / Special / Yoolw101 / Yoolw101.lzh / ENG2JAP.YO < prev    next >
Lisp/Scheme  |  1998-09-19  |  9KB  |  308 lines
  1. ;    英語→日本語変換プログラム
  2. ;
  3. ;    単語の登録
  4. ;        (putprop 'word '((品詞の略号 "意味")(品詞の略号 "意味") 'English))
  5. ;        例
  6. ;            (putprop 'I '((n . "私")) 'English)
  7. ;            (putprop 'have '((vt . "持っている")) 'English)
  8. ;            (putprop 'a '((def . "１つの")) 'English)
  9. ;    単語の意味の取り出し方
  10. ;        (get 'ward 'English)
  11. ;
  12. (setq error '(promp ">>"))
  13. ;    文字の最初が大文字なら小文字に変換
  14. ;    文字の最後にピリオドがあったら取り除く
  15. (de 'b2l '(lambda(x)(prog(str)
  16.     (setq str x)
  17.     (if
  18.         (or (> (ascii "A") (ascii str)) (< (ascii "Z") (ascii str)))
  19.         nil
  20.         (setq str (concat
  21.             (char (+ (- (ascii str) (ascii "A")) (ascii "a")))
  22.             (substr str 2 (strlng str))
  23.         ))
  24.     )
  25.     (if
  26.         (eq (ascii (substr str (strlng str) (strlng str))) (ascii "."))
  27.         (setq str (substr str 1 (- (strlng str) 1)))
  28.     )
  29.     (return str)
  30. )))
  31. ;    メインルーチン
  32. (de 'e2j '(lambda()(prog()
  33.     (print "＊＊＊　英語→日本語　翻訳プログラム　＊＊＊")
  34.     (print "    使い方")
  35.     (print "        I have a pen.のように入力して下さい。")
  36.     (print "        今は、第１文型と第２文型、第３文型の肯定文と")
  37.     (print "        命令文しか翻訳出来ません。")
  38.     (print "    終了する時は、endとタイプして下さい。")
  39.     (promp "E2J>")
  40.     (loop(eng x)
  41.         (setq eng (sread))
  42.         (setq eng (b2l eng))
  43.         (if
  44.             (not (listp (s2l eng)))
  45.             (setq eng (s2l (concat "(" eng ")")))
  46.             (setq eng (s2l eng))
  47.         )
  48.         (cond
  49.             ((or (eq (car eng) 'end) (eq (car eng) 'END))(return t))
  50.         )
  51.         (setq x (e2j_bunkatu eng))
  52.         (cond
  53.             ((null x) (print "この英語は、翻訳出来ません!"))
  54.             (t (e2j_showj x))
  55.         )
  56.     )
  57.     (print "英語→日本語　翻訳プログラムを終了します！")
  58.     (print "再度、起動する時は(e2j)とタイプして下さい。")
  59.     (promp ">>")
  60. )))
  61. ;
  62. ;e2j_bunkatu
  63. ;    ((主部)(副詞)(直接目的語)(間接目的語)(補語)(述部))    
  64. ;
  65. (de 'e2j_bunkatu '(lambda(sentence)(prog(SUBJ ADVE VERB COMP IOBJ DOBJ x vtype bunkei meaning)
  66.     (setq SUBJ nil)
  67.     (setq ADVE nil)
  68.     (setq VERB nil)
  69.     (setq COMP nil)
  70.     (setq IOBJ nil)
  71.     (setq DOBJ nil)
  72.     (setq x sentence)
  73. ;    主部の取り出し
  74.     (loop()
  75.         (if (null x) (return nil))
  76.         (setq meaning (get (car x) 'English))
  77.         (cond
  78.             ((and (null (assoc meaning 'vi)) (null (assoc meaning 'vt)) (null (assoc meaning 'aux)) (null (assoc meaning 'ad)))
  79.                 (setq SUBJ (append SUBJ (list (car x))))
  80.             )
  81.             (t (return t))
  82.         )
  83.         (setq x (cdr x))
  84.     )
  85. ;    述部の取り出し
  86.     (setq sentence nil)
  87.     (setq vtype nil)
  88.     (loop()
  89.         (if (null x) (return nil))
  90.         (setq meaning (get (car x) 'English))
  91.         (cond
  92.             ((not (null (assoc meaning 'vi)))
  93.                 (prog()
  94.                     (setq VERB (append VERB (list (car x))))
  95.                     (setq vtype 'vi)
  96.                 )
  97.             )
  98.             ((not (null (assoc meaning 'vt)))
  99.                 (prog()
  100.                     (setq VERB (append VERB (list (car x))))
  101.                     (setq vtype 'vt)
  102.                 )
  103.             )
  104.             ((not (null (assoc meaning 'ad)))
  105.                 (setq ADVE (cons (car x) ADVE))
  106.             )
  107.             ((not (null (assoc meaning 'aux)))
  108.                 (setq VERB (cons (car x) VERB))
  109.             )
  110.             (t (setq sentence (append sentence (list (car x)))))
  111.         )
  112.         (setq x (cdr x))
  113.     )
  114. ;目的語・補語の取り出し
  115.     (cond
  116.         ((null vtype) nil)
  117.         ((eq vtype 'vi) (setq COMP sentence))
  118.          ((eq vtype 'vt) (setq DOBJ sentence))
  119.         (t nil)
  120.     )
  121.     (return (list SUBJ ADVE IOBJ DOBJ COMP VERB))
  122. )))
  123. (de 'e2j_showj '(lambda(sentlist)(prog(meirei)
  124.     (setq meirei nil)
  125.     (prog()
  126. ;主語の翻訳
  127.         (cond
  128.             ((null (car sentlist)) (setq meirei t))
  129.             (t (prog()
  130.                 (e2j_print (car sentlist) nil)
  131.                 (princ "は、")
  132.             ))
  133.         )
  134.         (setq sentlist (cdr sentlist))
  135. ;副詞の翻訳
  136.         (cond
  137.             ((null (car sentlist)) nil)
  138.             (t (prog()
  139.                 (e2j_print (car sentlist) 'ad)
  140.             ))
  141.         )
  142.         (setq sentlist (cdr sentlist))
  143. ;間接目的語の翻訳
  144.         (cond
  145.             ((null (car sentlist)) nil)
  146.             (t (prog()
  147.                 (e2j_print (car sentlist) nil)
  148.                 (princ "に、")
  149.             ))
  150.         )
  151.         (setq sentlist (cdr sentlist))
  152. ;直接目的語の翻訳
  153.         (cond
  154.             ((null (car sentlist)) nil)
  155.             (t (prog()
  156.                 (e2j_print (car sentlist) nil)
  157. ;                (princ "を、")
  158.             ))
  159.         )
  160.         (setq sentlist (cdr sentlist))
  161. ;補語の翻訳
  162.         (cond
  163.             ((null (car sentlist)) nil)
  164.             (t (prog()
  165.                 (e2j_print (car sentlist) nil)
  166.                 (princ "")
  167.             ))
  168.         )
  169.         (setq sentlist (cdr sentlist))
  170. ;動詞の翻訳
  171.         (cond
  172.             ((null (car sentlist)) (print "動詞が見付かりません！"))
  173.             (t (prog()
  174.                 (e2j_print (car sentlist) nil)
  175.                 (e2j_print (car sentlist) 'aux)
  176.             ))
  177.         )
  178.     )
  179.     (if meirei
  180.         (print "ようにしなさい！")
  181.         (print "。")
  182.     )
  183. )))
  184. (de 'e2j_print '(lambda(x y)(cond
  185.     ((null x) nil)
  186.     ((atom x) (cond
  187.         ((null y) (cond
  188.             ((null (get x 'English)) (princ x))
  189.             (t (princ (cdar (get x 'English))))
  190.         ))
  191.         (t (cond
  192.             ((null (assoc (get x 'English) y)) t)
  193.             (t (princ (cdr (assoc (get x 'English) y))))
  194.         ))
  195.     ))
  196.     ((not (null y)) (prog()
  197.         (e2j_print (car x) y)
  198.         (e2j_print (cdr x) y)
  199.     ))
  200.     (t (prog()
  201.         (cond
  202.             ((and (atom (car x)) (null (get (car x) 'English)))
  203.                 (e2j_print (car x) nil)
  204.             )
  205.             ((null (cdr x))(e2j_print (car x) nil))
  206.             (t (prog()
  207.                 (e2j_print (car x) 'def)
  208.                 (e2j_print (car x) 'a)
  209.                 (e2j_print (car x) 'ad)
  210.             ))
  211.         )
  212.         (e2j_print (cdr x) nil)
  213.     ))
  214. )))
  215.  
  216. (putprop 'I '((n . "私")) 'English)
  217. (putprop 'i '((n . "私")) 'English)
  218. (putprop 'my '((a . "私の")) 'English)
  219. (putprop 'mine '((n . "私の物")) 'English)
  220. (putprop 'you '((n . "あなた")) 'English)
  221. (putprop 'your '((a . "あなたの")) 'English)
  222. (putprop 'yours '((n . "私の物")) 'English)
  223. (putprop 'he '((n . "彼")) 'English)
  224. (putprop 'his '((a . "彼の")(n . "彼の物")) 'English)
  225. (putprop 'she '((n . "彼女")) 'English)
  226. (putprop 'her '((a . "彼女の")) 'English)
  227. (putprop 'hers '((n . "彼女の物")) 'English)
  228. (putprop 'it '((n . "それ")) 'English)
  229. (putprop 'its '((a . "その")) 'English)
  230. (putprop 'this '((n . "これ")(a . "この")) 'English)
  231. (putprop 'that '((n . "あれ")(a . "あの")) 'English)
  232. (putprop 'pen '((n . "ペン")) 'English)
  233. (putprop 'pens '((n . "ペン")) 'English)
  234. (putprop 'pencil '((n . "鉛筆")) 'English)
  235. (putprop 'pencils '((n . "鉛筆")) 'English)
  236. (putprop 'desk '((n . "机")) 'English)
  237. (putprop 'desks '((n . "机")) 'English)
  238. (putprop 'chair '((n . "いす")) 'English)
  239. (putprop 'chairs '((n . "いす")) 'English)
  240. (putprop 'watch '((n . "時計")) 'English)
  241. (putprop 'watches '((n . "時計")) 'English)
  242. (putprop 'student '((n . "学生")) 'English)
  243. (putprop 'students '((n . "学生")) 'English)
  244. (putprop 'teacher '((n . "先生")) 'English)
  245. (putprop 'teachers '((n . "先生")) 'English)
  246. (putprop 'dog '((n . "犬")) 'English)
  247. (putprop 'dogs '((n . "犬")) 'English)
  248. (putprop 'cat '((n . "猫")) 'English)
  249. (putprop 'cats '((n . "猫")) 'English)
  250. (putprop 'apple '((n . "リンゴ")) 'English)
  251. (putprop 'apples '((n . "リンゴ")) 'English)
  252. (putprop 'ogange '((n . "オレンジ")) 'English)
  253. (putprop 'oganges '((n . "オレンジ")) 'English)
  254. (putprop 'name '((n . "名前")) 'English)
  255. (putprop 'hat '((n . "帽子")) 'English)
  256. (putprop 'hats '((n . "帽子")) 'English)
  257. (putprop 'shopping '((n . "買い物")) 'English)
  258. (putprop 'baseball '((n . "野球")) 'English)
  259. (putprop 'tennis '((n . "テニス")) 'English)
  260. (putprop 'swimming '((n . "水泳")) 'English)
  261. (putprop 'English '((n . "英語")(a . "英国の")) 'English)
  262. (putprop 'Japanese '((n . "日本語")(a . "日本語の")) 'English)
  263. (putprop 'one '((n . "物")(n . "１つ")(a . "１つの")) 'English)
  264. (putprop 'another '((n . "もう１つ")) 'English)
  265. (putprop 'two '((n . "２")(a . "２つの")) 'English)
  266. (putprop 'three '((n . "３")(a . "３つの")) 'English)
  267. (putprop 'is '((vi . "です")) 'English)
  268. (putprop 'am '((vi . "です")) 'English)
  269. (putprop 'are '((vi . "です")) 'English)
  270. (putprop 'like '((vt . "を好む")) 'English)
  271. (putprop 'thank '((vt . "に感謝する")) 'English)
  272. (putprop 'have '((vt . "を持っている")) 'English)
  273. (putprop 'get '((vt . "を手に入れる")) 'English)
  274. (putprop 'feel '((vi . "と感じる")) 'English)
  275. (putprop 'play '((vt . "で遊ぶ")(vi . "遊ぶ")) 'English)
  276. (putprop 'make '((vt . "を作る")) 'English)
  277. (putprop 'run '((vi . "走る")) 'English)
  278. (putprop 'go '((vi . "行く")) 'English)
  279. (putprop 'come '((vi . "来る")) 'English)
  280. (putprop 'speak '((vt . "を話す") (vi . "話す")) 'English)
  281. (putprop 'can '((aux . "ことができる")) 'English)
  282. (putprop 'will '((aux . "だろう")) 'English)
  283. (putprop 'must '((aux . "必要がある")) 'English)
  284. (putprop 'may '((aux . "に違いない")) 'English)
  285. (putprop 'a '((def . "１つの")) 'English)
  286. (putprop 'an '((def . "１つの")) 'English)
  287. (putprop 'the '((def . "")) 'English)
  288. (putprop 'good '((a . "良い")) 'English)
  289. (putprop 'fine '((a . "良い")) 'English)
  290. (putprop 'red '((a . "赤い")) 'English)
  291. (putprop 'blue '((a . "青い")) 'English)
  292. (putprop 'green '((a . "緑の")) 'English)
  293. (putprop 'yellow '((a . "黄色い")) 'English)
  294. (putprop 'fast '((ad . "速く")) 'English)
  295. (putprop 'always '((ad . "いつも")) 'English)
  296. (putprop 'sometimes '((ad . "時々")) 'English)
  297. (putprop 'often '((ad . "しばしば")) 'English)
  298. (putprop 'well '((ad . "うまく") (a . "健康")) 'English)
  299. ;pleaseは本当は動詞ですが、当翻訳ソフトでは副詞で定義します
  300. (putprop 'please '((ad . "どうか")) 'English)
  301. (putprop 'here '((ad . "ここへ")(n . "ここ")) 'English)
  302. (putprop 'there '((ad . "そこへ")(n . "そこ")) 'English)
  303.  
  304. "                英文和訳プログラム"
  305. "(e2j)：英文和訳プログラムを起動する。後はメッセージに従って英文を"
  306. "       入力してください。"
  307.  
  308.