\u5fae\u5206\u306a\u3069\u3067\u8907\u96d1\u306b\u306a\u3063\u305f\u7b97\u8853\u5f0f\u3092\u7c21\u7d20\u5316\u3059\u308b\u306b\u306f\u6b21\u306e\u3088\u3046\u306b\u3059\u308b\u3002<\/p>\n

\r\n(define (simple exp)\r\n  (define (flat lst op)\r\n    (append-map! (lambda (x)\r\n                   (if (and (pair? x) (eq? (car x) op))\r\n                       (flat (cdr x) op)\r\n                       (list x)))\r\n                 lst))\r\n  \r\n  (define (constant-fold args init op)\r\n    (define (cf args num acc)\r\n      (cond ((null? args)\r\n             (values acc num))\r\n            ((number? (car args))\r\n             (cf (cdr args) (op num (car args)) acc))\r\n            (else\r\n             (cf (cdr args) num (append! acc (list (car args)))))))\r\n    (cf args init '() ))\r\n  \r\n  (define (simple-+ args)\r\n    (set! args (map simple args))\r\n    (set! args (flat args '+))\r\n    (receive (exps num) (constant-fold args 0 +)\r\n     (cond ((null? exps) num)\r\n           (else `(+ ,@args num)))))\r\n  \r\n  (define (simple-* args)\r\n    (call\/cc\r\n     (lambda (c)\r\n       (set! args (map simple args))\r\n       (set! args (flat args '*))\r\n       (map (lambda (x)\r\n              (when (and (number? x) (= x 0))\r\n                    (c 0)))\r\n            args)\r\n       (set! args (constant-fold args 1 *))\r\n       (set! args (remove (lambda (x)\r\n                            (and (number? x)(= x 1)))\r\n                          args))\r\n       (if (= 1 (length args))\r\n           (car args)\r\n           `(* ,@args)))))\r\n\r\n  (define (simple-expt base ex)\r\n    (set! base (simple base))\r\n    (set! ex (simple ex))\r\n    (cond ((or (and (number? base) (= base 1))\r\n               (and (number? ex) (= ex 0)))\r\n           1)\r\n          ((or (and (number? base) (= base 0))\r\n               (and (number? ex) (= ex 1)))\r\n           base)\r\n          (else\r\n           `(expt ,base ,ex))))\r\n\r\n  (define (simple-- arg)\r\n    (cond ((number? arg) (- arg))\r\n          ((and (pair? arg)\r\n                (eq? (car arg) '+))\r\n           (simple-+ (map (lambda (x) (list '- x))\r\n                          (cdr arg))))\r\n          ((and (pair? arg)\r\n                (eq? (car arg) '*))\r\n           (simple-* (map (lambda (x) (list '- x))\r\n                          (cdr arg))))\r\n          (else\r\n           `(- ,arg))))\r\n  \r\n  (cond ((not (pair? exp)) exp)\r\n        ((eq? (car exp) '-)\r\n         (simple-- (cadr exp)))\r\n        ((eq? (car exp) '+)\r\n         (simple-+ (cdr exp)))\r\n        ((eq? (car exp) '*)\r\n         (simple-* (cdr exp)))\r\n        ((eq? (car exp) 'expt)\r\n         (simple-expt (cadr exp) (caddr exp)))\r\n        (else\r\n         `(,(car exp) ,@(map simple (cdr exp))))))\r\n<\/pre>\n
\r\n> (simple (deriv '(expt (* (sin x) (cos x)) 1\/2) 'x))\r\n=> (* (expt (* (sin x) (cos x)) -1\/2) (+ (* (cos x) (cos x)) (* (sin x) (- (sin x)))) 1\/2)\r\n<\/pre>\n
`-‘ \u6f14\u7b97\u5b50\u306f\u5358\u9805\u6f14\u7b97\u5b50\u3068\u3057\u3066\u306e\u307f\u4f7f\u3048\u308b\u3002<\/p>\n","protected":false},"excerpt":{"rendered":"
\u5fae\u5206\u306a\u3069\u3067\u8907\u96d1\u306b\u306a\u3063\u305f\u7b97\u8853\u5f0f\u3092\u7c21\u7d20\u5316\u3059\u308b\u306b\u306f\u6b21\u306e\u3088\u3046\u306b\u3059\u308b\u3002 (define (simple exp) (define (flat lst op) (append-map! (lambda (x) (if (and (pair? x) (eq? (car x) op)) (flat (cdr x) op) (list x))) lst)) (define (constant-fold args init op) (define (cf args num acc) (cond ((null? args) (values Continue reading   [\u6570\u5f0f\u51e6\u7406][Scheme] \u7b97\u8853\u5f0f\u3092\u7c21\u5358\u306b\u3059\u308b<\/span>→<\/span><\/a><\/p>\n","protected":false},"author":2,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":[],"categories":[3],"tags":[236,272,271],"amp_enabled":true,"_links":{"self":[{"href":"https:\/\/blog.bugyo.tk\/b-log\/wp-json\/wp\/v2\/posts\/775"}],"collection":[{"href":"https:\/\/blog.bugyo.tk\/b-log\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/blog.bugyo.tk\/b-log\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/blog.bugyo.tk\/b-log\/wp-json\/wp\/v2\/users\/2"}],"replies":[{"embeddable":true,"href":"https:\/\/blog.bugyo.tk\/b-log\/wp-json\/wp\/v2\/comments?post=775"}],"version-history":[{"count":13,"href":"https:\/\/blog.bugyo.tk\/b-log\/wp-json\/wp\/v2\/posts\/775\/revisions"}],"predecessor-version":[{"id":817,"href":"https:\/\/blog.bugyo.tk\/b-log\/wp-json\/wp\/v2\/posts\/775\/revisions\/817"}],"wp:attachment":[{"href":"https:\/\/blog.bugyo.tk\/b-log\/wp-json\/wp\/v2\/media?parent=775"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/blog.bugyo.tk\/b-log\/wp-json\/wp\/v2\/categories?post=775"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/blog.bugyo.tk\/b-log\/wp-json\/wp\/v2\/tags?post=775"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}