1. Куча / Говнокод #7002

    +131

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    72. 72
    73. 73
    74. 74
    75. 75
    76. 76
    77. 77
    78. 78
    79. 79
    (defparameter n 2)
    (setf middle (make-array 2 :initial-element 0))
    (defparameter v 7)
    (setf tr (make-array `(,(+ 1 n) ,n) :initial-element 4))
    (setf ftr (make-array 3 :initial-element 1))
    (defun pow (x n)
    (cond((= n 0) 1)((= n 1) x)(T (* x (pow x (- n 1))))))
    (defun f1 (x y)
    (+ (* (pow v 2) (pow x 2))
    (* (/ v (+ v 1)) x)
    (* 15 (+ v 1) (pow y 2))
    (* -1 2 v y) (* 4 v)))
    
    (defun sigma1 (a)
    (* a (/ (+ (sqrt (+ n 1)) (- n 1))
    (* n (sqrt 2))) ))
    
    (defun sigma2 (a)
    (* a (/ (+ (sqrt (+ n 1)) -1)
    (* n (sqrt 2))) ))
    
    (defun setp (a)
    (loop for i from 1 to n do
    (loop for j from 0 to (- n 1) do
    (cond
    ((= (- i 1) j) (setf (aref tr i j) (+ (aref tr 0 0) (sigma2 a))))
    (T (setf (aref tr i j) (+ (aref tr 0 1) (sigma1 a))))))))
    
    (defun evalfun ()
    (loop for i from 0 to n do
    (setf (aref ftr i) (f1 (aref tr i '0) (aref tr i '1)))
    (format t "The functions in dot ~$:~$~$" `(,(aref tr i '0) ,(aref tr i '1)) (aref ftr i) #\newline))
    (setf ftr (sort ftr #'<)))
    
    (defun midp()
    (loop for i from 0 to n do
    (cond
    ((= (aref ftr n) (f1 (aref tr i '0) (aref tr i '1)))
    (setq tp i))))
    
    (setf middle (make-array n :initial-element 0))
    (loop for i from 0 to n do
    (cond
    ((/= i tp)
    (setf (aref middle 0) (+ (aref middle 0) (aref tr i 0)))
    (setf (aref middle 1) (+ (aref middle 1) (aref tr i 1))))))
    (setf (aref middle 1) (/ (aref middle 1) 2))
    (setf (aref middle 0) (/ (aref middle 0) 2))
    (format t "The weight center in ~$,~$" (aref middle 0) (aref middle 0))
    (princ #\newline))
    
    (defun newp()
    (setf (aref tr tp 0) (- (aref middle 0) (aref tr tp 0)))
    (setf (aref tr tp 1) (- (aref middle 1) (aref tr tp 1))))
    (defun prpolinom()
    (format t "Polinom has this dots:~$" #\newline)
    (loop for i to n do
    (loop for j to (- n 1) do
    (format t "|~$|" (aref tr i j)))
    (princ #\newline)))
    
    (setq c 1)
    (defun mloop(a)
    (setp a)
    (defun subloop()
    (setq c (+ c 1))
    (setf tmiddle (make-array n :initial-element 0))
    (loop for i to (- n 1) do
    (setf (aref tmiddle i) (aref middle i)))
    (evalfun)
    (midp)
    (newp)
    (prpolinom)
    
    (cond
    ((and (= (aref tmiddle 0) (aref middle 0)) (= (aref tmiddle 1) (aref middle 1)))(mloop (/ a 2)))
    ((> a 0.01) (subloop) (format t "Iteration ~$~$" c #\newline))))
    (subloop))
    (mloop 2)

    симплекс метод на Common Lisp=)

    Запостил: zura, 20 Июня 2011

    Комментарии (24) RSS

    • Ну императивненько... И что?
      Что вам не понравилось?
      Ответить
      • уверен что можно было проше сделать...
        Ответить
        • Проще можно сделать почти всегда, но лучше ли?
          Ответить
          • думаю что да... к тому же работает не совсем правильно(делает на одну итерацию больше, чем надо) и принципы языка соблюдены чуть менее чем не соблюдены вообше=)
            Ответить
            • >делает на одну итерацию больше, чем надо
              Ох какая страшная беда...

              >принципы языка соблюдены чуть менее чем не соблюдены вообше
              В CL их в принципе нет. Любой код на CL не поддерживаемый с таким гибким синтаксисом языка и его макросистемой.
              Ответить
    • хоть лисп и уважаемый дедушка, говно-концепций есть у него.
      Ответить
    • (defun pow (x n) ...)
      Уже только за это плюсовать нужно :) Дальше даже читать не стал. Ну, тут как бы скорее всего человек в принципе программировал, но на другом языке (хз, мож на Паскаль похоже?), а почему именно Лисп выбрал для осуществления задуманного - не понятно.
      Ответить
      • показать все, что скрытоstd lib не знает, да и SICP не читал (сразу видно). Мораль - не умеешь писать на языке богов - не берись. Write in C.
        Ответить
        • >Мораль - не умеешь писать на языке петушков - не берись.
          fix
          не благодари
          Ответить
      • а на паскаль чем похоже?=) я немного не догнал....
        Ответить
        • Видимо, он имел ввиду, что похоже это программу писал человек, ранее писавший только на императивных языках.
          Ответить
        • Форматирование в духе Паскаля - я больше ни в одном языке не видел, чтобы вложеные циклы не форматировали отступами (в том смысле, что это не особенность Паскаля, но как-то если на нем новички пишут, то почему-то у них есть такая тенденция).

          EDIT: Кстати, только что заметил, тоже шедевр :)
          (format t "|~$|" (aref tr i j)))
          (princ #\newline)
          Ответить
          • тю... так ты об этом=) отступы какого-то фига слетели когда пастил=) если без отступов там вообше ничерта не ясно будет=) да и некоторые скобки пришлось строкой выше поднимать, ибо всё не влазило=)
            ЗЫ а я и не заметил=) реально шедевр=)
            Ответить
          • а смысл был всего лиш в том, что после выполнения внутреннего цикла добавляется перенос строки=)
            Ответить
        • О, и вот это... блин :)
          (format t "Polinom has this dots:~$" #\newline)

          Ну как бы человек впервые в жизни видимо писал, как бы со второго раза уже такие дурацкие ошибки никто бы не делал :)
          Ответить
    • Anyone could learn Lisp in one day, except that if they already knew Fortran, it would take three days.

      На второй день фортраноид пишет вот такое. Это не LISP - это подстрочник с хренового C на LISP.
      Ответить
      • это все, на что способен кодер, не привыкший к обратной польской записи
        Ответить
    • показать все, что скрытоvanished
      Ответить
    • показать все, что скрытоvanished
      Ответить

    Добавить комментарий