Форум программистов, компьютерный форум, киберфорум
Наши страницы
Бета-тестирование
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.75/4: Рейтинг темы: голосов - 4, средняя оценка - 4.75
_Ivana
4041 / 1881 / 235
Регистрация: 01.03.2013
Сообщений: 5,119
Записей в блоге: 20
1

Liscript - РЕПЛ в виде бота на гиттере (слаке, телеграме, ИРЦ)

24.02.2017, 16:44. Просмотров 737. Ответов 9
Метки нет (Все метки)

Прикрутил чат-бот интерфейсы к своему эвалюатору. Можно посмотреть на гиттере https://gitter.im/liscript/public .
0
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
24.02.2017, 16:44
Ответы с готовыми решениями:

Чат в телеграме для форумчан
Как насчет того, чтобы создать чат в телеграме для форумчан? Добавлено через 4 часа 15 минут...

Разрешение Копирования Данных Из Документа С Блокировкой Создания Репл
Всем доброго дня! Возможно ли такое реализовать? Мудрил с полем $KeepPrivate, ничего толкового...

Liscript
Дабы не скакать по разным разделам, выбрал жить здесь - в наиболее подходящем (если модераторы не...

Реализация интерфейса Liscript интерпретатора
Пишу GUI приложение. В перспективе хочу портировать на Андроид, но поскольку с Java не сталкивался,...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
9
_Ivana
4041 / 1881 / 235
Регистрация: 01.03.2013
Сообщений: 5,119
Записей в блоге: 20
06.03.2017, 04:05  [ТС] 2
Можно посмотреть на других мессенжерах https://liscript.herokuapp.com/
0
MrOnlineCoder
Всегда онлайн
593 / 490 / 201
Регистрация: 07.04.2013
Сообщений: 2,035
Завершенные тесты: 2
07.03.2017, 13:28 3
_Ivana, у вас полетели кодировки на сайте.
Кликните здесь для просмотра всего текста

Код
Liscript

а”аАаНаНаОаЕ аПб€аИаЛаОаЖаЕаНаИаЕ аОаБаЕбаПаЕб‡аИаВаАаЕб‚ б€аАаБаОб‚бƒ аБаОб‚аОаВ аВ аНаИаЖаЕаПаЕб€аЕб‡аИбаЛаЕаНаНб‹б… аМаЕббаЕаНаЖаЕб€аАб…. аšаАаЖаДб‹аЙ аБаОб‚ б€аЕаАаЛаИаЗбƒаЕб‚ б„бƒаНаКб†аИаОаНаАаЛбŒаНаОбб‚бŒ REPL-аИаНб‚аЕб€аПб€аЕб‚аАб‚аОб€аА аЛаИбаПаОаПаОаДаОаБаНаОаГаО баЗб‹аКаА Liscript, аПаО баИаНб‚аАаКбаИббƒ аИ баЕаМаАаНб‚аИаКаЕ аБаЛаИаЗаКаОаГаО аК Scheme. а‘аОб‚ аНаЕаПб€аЕб€б‹аВаНаО аПб€аОбаЛбƒбˆаИаВаАаЕб‚ аКаАаНаАаЛ (аИ аЛаИб‡аНб‹аЕ баОаОаБб‰аЕаНаИб) аИ аДаЛб аКаАаЖаДаОаГаО аПаОбб‚бƒаПаИаВбˆаЕаГаО баОаОаБб‰аЕаНаИб аЗаАаПбƒбаКаАаЕб‚ аПаОб‚аОаК аВб‹б‡аИбаЛаЕаНаИб, аИаНб‚аЕб€аПб€аЕб‚аИб€бƒб аЕаГаО аКаАаК аВб‹б€аАаЖаЕаНаИаЕ баЗб‹аКаА Liscript, аВ баЛбƒб‡аАбб…, аЕбаЛаИ баОаОаБб‰аЕаНаИаЕ баВаЛбаЕб‚бб:
0
_Ivana
4041 / 1881 / 235
Регистрация: 01.03.2013
Сообщений: 5,119
Записей в блоге: 20
07.03.2017, 17:31  [ТС] 4
MrOnlineCoder, странно. "На моей машине все работает" (С)

Кликните здесь для просмотра всего текста
Liscript

Данное приложение обеспечивает работу ботов в нижеперечисленных мессенжерах. Каждый бот реализует функциональность REPL-интерпретатора лиспоподобного языка Liscript, по синтаксису и семантике близкого к Scheme. Бот непрерывно прослушивает канал (и личные сообщения) и для каждого поступившего сообщения запускает поток вычисления, интерпретируя его как выражение языка Liscript, в случаях, если сообщение является:

связанным в текущем глобальном окружении символом: map
применением особой формы языка: + 1 2 3
применением функции: map (lambda (x) + 1 x) '(1 2 3 4 5)
применением макроса: defn f (x) * 10 x
Сообщения, не попадающие под данные категории, остаются без ответа. Для каждой комнаты канала, прослушиваемой ботом, и для каждого персонального чата с ботом создается отдельное глобальное окружение, в которое загружается стандартная библиотека языка. Ограничений времени на вычисление нет, но в каждой комнате/персональном чате каждый пользователь может запустить только один поток. Если вычисление зациклилось или пользователь по каким-либо другим причинам желает прервать его, то это делается волшебной командой бота: !

IRC

Канал #liscript, доступ с любого локального клиента или через вэб-интерфейс freenode, бот liscript-bot
Telegram

Открытая группа Liscript, инвайт-линк, бот - name: Liscript-bot, username: @LiscriptBot
Slack

Открытая группа Liscript, инвайт-линк, бот @liscript-bot
Gitter

Открытая группа, бот @eva-lu-ator
Приватные сообщения не обрабатываются.
Полезные ссылки

Краткое описание языка
Проект с десктопным графическим интерфейсом
Данное приложение реализовано как web и опубликовано на Heroku бесплатно, поэтому имеет ограниченный набор часов работы в месяц. Для экономии часов Heroku останавливает работу приложения, если в течение получаса не было запроса к web-приложению. Для активации приложения достаточно зайти на эту страницу или обновить ее в браузере.


HTML-файл в кодировке WTF-8. Не знаю что там американская херока творит. Может санкции, русофобия и кремлевские хакеры...
0
07.03.2017, 17:31
MrOnlineCoder
Всегда онлайн
593 / 490 / 201
Регистрация: 07.04.2013
Сообщений: 2,035
Завершенные тесты: 2
08.03.2017, 18:55 5
_Ivana, WTF-8?

Добавлено через 1 минуту
У вас <head> пустой, укажите там
HTML5
1
<meta charset="utf-8">
1
_Ivana
4041 / 1881 / 235
Регистрация: 01.03.2013
Сообщений: 5,119
Записей в блоге: 20
09.03.2017, 15:38  [ТС] 6
Ну вы же поняли и юмор, и какая кодировка

Добавлено через 1 минуту
Аааа, это просто мой первый хтмл-файл, я с вэбством не знаком Хорошо, поменяю, скорее всего сегодня вечером попозже.

Добавлено через 20 часов 41 минуту
Пофиксил несколько багов и добавил строки чарсета и заголовка в хедер, перезалил на сервер. Теперь все должно быть нормально.

ЗЫ глядя на спартанскую стартовую (и единственную) страницу приложения вы можете оценить мой уровень владения html/css Но несмотря на это, у меня в среднесрочных планах прикрутить вэб-интерфейс этому приложению.
0
_Ivana
4041 / 1881 / 235
Регистрация: 01.03.2013
Сообщений: 5,119
Записей в блоге: 20
06.07.2017, 18:55  [ТС] 7
Не прошло и полгода, как подъехал вэб-интерфейс РЕПЛа - https://liscript.herokuapp.com/repl

Демопример, адаптированный под вэб интерфейс (операторы print вынесены в read - вывод при блокирующем вводе). Можно прямо копипастить этот код в правое окно и запускать вычисление по кнопке или Ctrl + F12
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
(def ask-continue "Дальше?: ")
 
(read "Набор демо-примеров (общий обзор). Для продолжения (показа следующего примера) просто введите что-нибудь в окне ввода и нажмите Ctrl+Enter."
    \n ask-continue)
 
 
 
 
(defn Person (name surname address)
    (lambda (p)
        (cond (eq? "getname" p) name
              (eq? "getsurname" p) surname
              (eq? "getinfo" p) (++ name " " surname ": " address)
              (read "Неизвестное имя метода: " p \n))))
(defn find-by-field (f v l) (filter (lambda (p) (eq? v (p f))) l))
(defn show-person-list (l) (map (lambda (p) (p "getinfo")) l))
 
(def l (map eval '(
    (Person "Ivan" "Ivanov" "Moscow, Tverskaya 14")
    (Person "Anton" "Smirnov" "Omsk, Dunaeva 21")
    (Person "Andrew" "Ivanov" "Воронеж, Лизюкова 171/37")
    )))
(defn test (v l)
    ++ (++ v "-s:") \n (show-person-list (find-by-field "getsurname" v l)))
 
(read \n "ЗАДАЧА - функция, выдающая список персон по фамилии." \n
    "Исходный список:" \n (show-person-list l)
    \n (test "Ivanov" l)
    \n (test "Smirnov" l)
    \n (test "Petrov" l)
    \n ask-continue)
 
 
 
 
(defn fib (n) (cond (< n 2) n (+ (fib (- n 1)) (fib (- n 2)) )))
 
(defn fib-l (n)
    (defn go (i a b) (cond (<= i 0) a (go (- i 1) b (+ a b)) ))
    (go n 0 1))
 
(defn fib-e (n)
    (defn fib-iter (a b p q count)
      (cond (= count 0) b
            (= 0 (mod count 2))
                (fib-iter a b (+ (* p p) (* q q)) (+ (* q q) (* 2 p q)) (/ count 2) )
                (fib-iter (+ (* b q) (* a q) (* a p)) (+ (* b p) (* a q)) p q (- count 1)) ))
    (fib-iter 1 0 0 1 n))
    
(def n 20)  
(read \n "ЗАДАЧА - функция, вычисляющая число Фибоначчи:" \n
    "неоптимальным экспоненциальным алгоритмом:" \n "fib[" n "] = " (fib n) \n
    "более оптимальным линейным алгоритмом:" \n "fib[" n "] = " (fib-l n) \n 
    "волшебным логарифмическим алгоритмом:" \n "fib[" n "] = " (fib-e n) \n ask-continue)
 
 
 
 
(defn sqrt (x) (
    (defn sqrt-iter (guess) (cond (good-enough? guess) guess (sqrt-iter (improve guess)) ))
    (defn good-enough? (guess) (< (abs (- ((lambda (x) (* x x)) guess) x)) 0.000001))
    (defn improve (guess) (average guess (/ x guess)))
    (defn average (x y) (/ (+ x y) 2))
    (defn abs (x) (cond (< x 0) (- 0 x) x))
    (sqrt-iter 1.0)))
(def a 4)
(read \n "ЗАДАЧА - функция, вычисляющая квадратный корень:" \n
    "квадратный корень из " a " равен " (sqrt a) \n ask-continue)
 
 
 
 
(defn foo1 (l)
    (defn go (l s) (cond (null? l) nil (cons (+ s (car l)) (go (cdr l) (+ s (car l))))))
    (go l 0))
(defn foo2 (l)
    (defn go (l s r) (cond (null? l) r (go (cdr l) (+ s (car l)) (cons (+ s (car l)) r))))
    (reverse (go l 0 nil)))
(defn foo3 (l)
    (def s 0)
    (defn f (x a) (set! s (+ s x)) (cons s a))
    (reverse (foldl f nil l)))
(def l '(3 2 6 5 1))
(read \n "ЗАДАЧА - сформировать список частичных сумм заданного списка:" \n
    "исходный список: " l \n
    "результаты:" \n "1: " (foo1 l) \n "2: " (foo2 l) \n "3: " (foo3 l) \n ask-continue)
 
 
 
 
(defn poly-mul (a b)
    (defn winfold (l1 l2 acc)
        (cond (null? l1) acc
              (null? l2) acc
              (winfold (cdr l1) (cdr l2) (+ (* (car l1) (car l2)) acc)) ))
    (defn addzeros (n l) (cond (= 0 n) l (addzeros (- n 1) (cons 0 l)) ))
    (def la (length a) lb (length b))
    (def a0 (addzeros (- lb 1) a) b0 (addzeros (+ la lb -2) (reverse b)))
    (defn go (n a b r) (cond (= 0 n) r (go (- n 1) a (cdr b) (cons (winfold a b 0) r))))
    (go (+ la lb -1) a0 b0 nil) )
(defn show-poly (l)
    (defn go (l i)
        cond (null? l) ""
          (++ (cond (> (car l) 0) "+" "")
          (car l)
          (cond (= i 0) ""
                (= i 1) "x"
                (++ "x^" i))
          (go (cdr l) (+ i 1))) )
    (go l 0))
(def a '(0 1 2 3) b '(5 1 2 3))
(read \n "ЗАДАЧА - умножение многочленов:" \n
    (show-poly a) " * " (show-poly b) " = " (show-poly (poly-mul a b)) \n ask-continue)
 
 
 
 
(defn foo (l)
    (defn collect (x l)
        (cond (null? l) (cons (cons x 1) nil)
              (eq? x (car (car l))) (cons (cons x (+ 1 (car (cdr (car l))))) (cdr l))
              (cons (car l) (collect x (cdr l))) ))
    (foldl collect nil l))
(def l '(h e l l o w o r l d))
(read \n "ЗАДАЧА - посчитать количество вхождения элементов в список:" \n
    "входящий список: " l \n
    "результат: " (foo l) \n ask-continue)  
 
 
 
 
(defn foo (l1 l2)
    (def l1' (flatten l1))
    (def l2' (flatten l2))
    (filter (lambda (x) (noelem x l2')) l1'))
(def l1 '(-10 (-9 ((-8 -7 -6)) -5 (((-4 -3))) -2 -1) 0 1 2 3 4))
(def l2 '(5 ((((((-6 -5 -4 -3)))))) ((-8 -7 -6 -5) (((3 4 5 6 7))))))
(def r (foo l1 l2))
(read \n "ЗАДАЧА - исключить из первого множества элементы второго:" \n
    "входящие аргументы функции - списки сложной структуры:" \n l1 \n l2 \n
    "результат: " \n r \n ask-continue)
 
 
 
 
(defn derivative (f) (lambda (x) (/ (- (f (+ x 0.001)) (f x) ) 0.001)))
(defn n-der-1 (g n) (cond (> n 0) (derivative (n-der-1 g (- n 1))) g) )
(defn n-der-2 (g n) (cond (> n 0) (n-der-2 (derivative g) (- n 1)) g) )
(defn n-der-3 (f n)
    (defn iter (i g) (cond (> i 0) (iter (- i 1) (derivative g)) g) )
    (iter n f))
(defn f (x) (* x x x x x)) (def n 3) (def x 1)
(read \n "ЗАДАЧА - сформировать функции - производные n-го порядка исходной функции:" \n
    "функция: " f \n
    n "-я производная в точке " x " (вариант 1) = " ((n-der-1 f n) x) \n
    n "-я производная в точке " x " (вариант 2) = " ((n-der-2 f n) x) \n
    n "-я производная в точке " x " (вариант 3) = " ((n-der-3 f n) x) \n ask-continue)
 
 
 
 
(defn tree (n c)
    (defn st (n v) (cond (< n 1) "" (++ v (st (- n 1) v))))
    (defn go (i)
        (def vet (st (- n i) c))
        (cond (< i 1) \n
              (++ \n (st i " ") vet "|" vet (go (- i 1))) ))
    (++ (st n " ") "X" (go (- n 1))) )
(read \n "ЗАДАЧА - нарисовать 'елочку' заданного размера:" \n \n (tree 15 "@") \n ask-continue)
 
 
 
 
(defn make-tab (h qual)
    (def amount (cond (eq? qual low) (+ 12 (* 4 h)) (+ 14 (* 5 h)))) ;переопределяемое поле;
    (defn dispatch (p)
        (cond (eq? getamount p) amount
              (eq? getprice  p) (* (cond (eq? qual low) 2 (eq? qual mid) 3 4) (dispatch getamount))
              (eq? getinfo   p) (++ "height: " h ", quality: " qual
                                 ", amount: " (dispatch getamount) ", price: " (dispatch getprice))
              (eq? setamount (car p)) (set! amount (car (cdr p)))
              (read (++ "Неизвестное имя метода:" p))))
    dispatch)
(defn make-chear (h hb qual)
    ;родительский объект (с неопределенной высотой);
    (def tab (make-tab h qual))
    ;переопределение значения внутреннего поля;
    (tab (cons setamount (+ (tab getamount) (* 2 hb) 5)))
    tab)
(read \n "ЗАДАЧА - создать класс 'табуретка' и дочерний класс 'стул', переопределить поле:" \n
    "табуретка (20, mid): " ((make-tab 20 mid) getinfo) \n
    "стул (10, 2, low): " ((make-chear 10 2 low) getinfo) \n ask-continue)
 
 
 
 
(defn knight (m n)
    (defn exist-step (a b c)
        (cond (null? c) false
              (and (eq? a (car c)) (eq? b (cadr c))) true
              (exist-step a b (cdr c))))
 
    (defn next-pos (c)
        (def p (car c))
        (def s (filter (lambda (x) (and (<= 1 (car x) m) (<= 1 (cadr x) n)))
            (map (lambda (x) (cons (+ (car p) (car x)) (+ (cadr p) (cadr x))))
                 '((2 1) (1 2) (-1 2) (-2 1) (-2 -1) (-1 -2) (1 -2) (2 -1)) )))
        (filter (lambda (x) (not (exist-step x p c))) s) )
 
    (defn next-chains (c) (map (lambda (x) (cons x c)) (next-pos c) ))
 
    (def field-ps (concat (map (lambda (x) (map (lambda (y) (cons x y))
                               (list-from-to 1 n))) (list-from-to 1 m))))
    (defn full-chain (c)
        (and (eq? (car c) '(1 1)) (null? (filter (lambda (x) (not (elem x c))) field-ps))))
 
    (defn go (c)
        (def n-c (next-chains c))
        (cond (full-chain c) c
              (null? n-c) nil
              (foldl (lambda (x a) (cond (null? a) (go x) a)) nil n-c) ))
 
    (go '((1 1)) ))
 
(defn test (m n) (++ "для поля " m "*" n ":" \n (knight m n) \n ))
(read \n "ЗАДАЧА - на шахматной доске заданных размеров найти путь коня из стартовой клетки с возвращением в нее же, чтобы конь побывал во всех клетках поля:" \n
    (test 4 4) (test 4 5) (test 5 5) (test 5 6) ask-continue)
 
 
 
 
(defn miss-cann (m c)
 
    (defn solve-depth (state)
        (defn go (f)
            (def vars (steps f))
            (cond (solved? f) f
                  (null? vars) nil
                  (foldl (lambda (x a) (cond (null? a) (go x) a)) nil vars) ))
        (go state))
 
    (defn solve-wide (state)
        ; (print "Количество анализируемых вариантов: ") ;
        (defn go (vars)
            ; (print (++ (length vars) " ")) ;
            (def rezs (filter solved? vars))
            (cond (null? vars) nil
                  (not (null? rezs)) rezs
                  (go (concat (map steps vars))) ))
        (go (cons state nil)))
 
    (defn step-var (v state)
        (match state '((ml cl) (mr cr) boat-left))
        (def s (cond boat-left 1 -1) dm (* s (car v)) dc (* s (cadr v)))
        (cons (cons (- ml dm) (- cl dc))
              (cons (+ mr dm) (+ cr dc)) (not boat-left)) )
 
    (defn valid? (state)
        (match state '((ml cl) (mr cr) boat-left))
        (defn good (m c) not (all id (cons (< 0 m) (< 0 c) (< m c))))
        (all id (cons (<= 0 ml) (<= 0 cl) (<= 0 mr) (<= 0 cr)
                (good ml cl) (good mr cr) (< 0 (+ mr cr)) )))
 
    (defn steps (l)
        (def nexts (filter valid? (map (lambda (v) step-var v (car l)) vars)))
        (map (lambda (n) cons n l) (filter (lambda (v) not (elem v l)) nexts)))
 
    (defn solved? (state) all (lambda (x) = 0 x) (caar state))
 
    (defn show-res (l)
        (def rezult (++ \n "Вариант :" \n))
        (defn n-str (n s) cond (>= 0 n) "" (++ s (n-str (- n 1) s)))
        (defn m-c (m c) (++ (n-str m "М") (n-str c "К")))
 
        (defn go (l)
          (cond (null? l) ""
            (
            (match (car l) '((ml cl) (mr cr) boat-left))
            (set! rezult (++ rezult "Левый: " (m-c ml cl) ", правый: " (m-c mr cr) " - "))
            (cond (null? (cdr l)) (set! rezult (++ rezult "финиш" \n))
                (
                (match (cadr l) '((mln cln) _))
                (def dm (abs (- ml mln)) dc (abs (- cl cln)))
                (set! rezult (++ rezult (cond boat-left "туда: " "обратно: ") (m-c dm dc) \n))
                ))
            (go (cdr l))
            )))
        (go l)
        rezult)
 
    ; (def start-state (cons (cons (cons m c) '((0 0) true)) nil)) ;
    (def start-state (make '(((m c) (0 0) true)) ))
    ; (print start-state \n) ;
    (def vars '((1 0) (0 1) (2 0) (0 2) (1 1)) )
    
    (read \n "------  " m " миссионеров, " c " каннибалов:" \n \n
        "Поиск в глубину:" (show-res (reverse (solve-depth start-state)))
        \n "Поиск в ширину:" \n
        (foldl (lambda (l a) ++ a (show-res (reverse l))) "" (solve-wide start-state))      
        \n ask-continue)
    )
 
(read \n "ЗАДАЧА - Три миссионера и три каннибала должны пересечь реку в лодке, в которой могут поместиться только двое. Миссионеры должны соблюдать осторожность, чтобы каннибалы не получили на каком-либо берегу численное преимущество. Как переплыть реку?" \n ask-continue)
(miss-cann 2 2)
(miss-cann 3 3)
(miss-cann 4 4)
 
 
 
 
 
(def field '(
0 0 9 3 0 1 8 0 0
0 0 0 0 0 0 0 3 0
2 0 0 0 7 0 0 0 9
1 0 0 2 0 9 0 0 4
0 0 4 0 8 0 2 0 0
8 0 0 7 0 6 0 0 1
9 0 0 0 1 0 0 0 5
0 2 0 0 0 0 0 7 0
0 0 5 6 0 2 4 0 0))
 
(defn showField (f)
    (defn go (f)
        (cond (null? f) ""
          (++ (foldl (lambda (x a) (++ a x " ")) "" (take 9 f)) \n (go (drop 9 f))) ))
    (cond (null? f) "Нет решений" (go f)))
 
(defn steps (field)
    (defn step-vars (i)
        (def r (/ i 9) c (mod i 9) rs0 (* 3 (/ r 3)) cs0 (* 3 (/ c 3)))
        (defn squ-row (n) (take 3 (drop (+ cs0 (* 9 (+ rs0 n))) field)))
        (defn sieve-nth (l a) (cond (null? l) a (sieve-nth (drop 9 l) (cons (car l) a)) ))
 
        (foldl (lambda (l a) (filter (lambda (x) (noelem x l)) a) )
            '(1 2 3 4 5 6 7 8 9)
            (cons (squ-row 0) (squ-row 1) (sieve-nth (drop c field) (squ-row 2))
                (take 9 (drop (* 9 r) field)) nil) ))
 
    (defn rep-by-ind (i e l)
        (cond (null? l) nil
              (= 0 i)   (cons e (cdr l))
                        (cons (car l) (rep-by-ind (- i 1) e (cdr l))) ))
 
    (defn go (i min-i min-step-counts min-step-vars f)
        (cond (null? f)
                  (cond (= min-step-counts 100) (cons field nil)
                        (= min-step-counts 0)   nil
                            ( ; (print " i = " min-i ", steps = " min-step-vars \n) ;
                            (map (lambda (v) (rep-by-ind min-i v field)) min-step-vars)))
              (= 0 (car f))
                  ((def i-step-vars (step-vars i) i-step-counts (length i-step-vars))
                  (cond (< i-step-counts min-step-counts)
                      (go (+ i 1) i i-step-counts i-step-vars (cdr f))
                      (go (+ i 1) min-i min-step-counts min-step-vars (cdr f))))
              (go (+ i 1) min-i min-step-counts min-step-vars (cdr f)) ))
 
    (go 0 0 100 0 field))
 
(defn solve-depth (field)
    (defn go (f)
        (def vars (steps f))
        (cond (noelem 0 f) f
              (null? vars) nil
              (foldl (lambda (x a) (cond (null? a) (go x) a)) nil vars) ))
    (go field))
 
(defn solve-wide (field)
    ; (print "Количество анализируемых вариантов: ") ;
    (defn go (vars)
        ; (print (++ (length vars) " ")) ;
        (cond (null? vars) nil
              (noelem 0 (car vars)) vars
              (go (concat (map steps vars))) ))
    (go (cons field nil)))
 
(read \n "ЗАДАЧА - решение судоку, реализация поиска в глубину и в ширину:" \n
    "Стартовое поле:" \n (showField field) \n ask-continue)
 
(read "Решение поиском в глубину:" \n (showField (solve-depth field))
    \n "Поиск в ширину займет некоторое время..." \n ask-continue)
 
(def solunions (solve-wide field))
(read \n "Решения поиском в ширину:" \n
    (cond (null? solunions) (++ "Нет решений" \n)
        (foldl (lambda (x a) (++ a (showField x) \n)) "" solunions) ) \n ask-continue)
 
"
Код данных примеров вы можете посмотреть в файле."
0
_Ivana
4041 / 1881 / 235
Регистрация: 01.03.2013
Сообщений: 5,119
Записей в блоге: 20
08.08.2017, 14:18  [ТС] 8
Обновил интерфейс веб-сайта https://liscript.herokuapp.com/
Меню (какое смог накостылить), статика/демки, ссылки и конечно РЕПЛ.

ЗЫ по первым отзывам буду менять фоны/оформление/шрифты и т.п.
0
MrOnlineCoder
Всегда онлайн
593 / 490 / 201
Регистрация: 07.04.2013
Сообщений: 2,035
Завершенные тесты: 2
11.08.2017, 22:53 9
_Ivana, интерфейс понравился.

Не по теме:

А какая цель этого проекта?

0
_Ivana
4041 / 1881 / 235
Регистрация: 01.03.2013
Сообщений: 5,119
Записей в блоге: 20
12.08.2017, 02:30  [ТС] 10
Цель... Читал СИКП, в хаскель чате кто-то случайно сказал, что каждый программист должен написать свой язык, я поверил и загорелся идеей написать свою реализацию - чтобы полностью разобраться как оно все устроено, написал на Хаскеле, потом захотел портировать сыну на Андроид - переписал на Джаве, до Андроида не дошел - приделал десктопный гуй, потом решил попробовать ботов, сейчас вот первое вэб-приложение осилил Это не цели конечно, а причины и мотивация. Для потенциальной аудитории может быть интересно освоить азы ФП через мой язык, порешать тот же СИКП на нем, спросить у меня как оно все устроено Для меня - разобраться в принципах, попрактиковаться в Хаскеле/Джаве/вэбе ну и если повезет - ссылку на проект увидят потенциальные работодатели и это поможет им решиться предложить мне работу (хотя я наверное идеалист и слишком оптимистичен)

Или ты что-то другое имел в виду про цель?
0
12.08.2017, 02:30
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.
Рейтинг@Mail.ru