База студентов

@ывац422м · Регистрация: 23.02.2013

Студворк — интернет-сервис помощи студентам

Добрый день!
Помогите написать базу студентов, самую простую, должна быть реализована с помощью списков и должна выполнять добавление, вывод всего списка и удаление элемента. Пользователь вводит номер студента, имя и фамилию. Спасибо заранее!

@castorsky · 16.06.2014, 14:08

ывац422м, предлагаю нумерацию студентов автоматизировать без привязки конкретного номера к конкретному студенту как упражнение.

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
;;racket
 
;; data base
(define stud-db '())
 
;; student constructor
(define (stud-make (in null) (f-name null) (l-name null))
  (printf ";index: ") (set! in (read))
  (printf ";first name: ") (set! f-name (read))
  (printf ";last name: ") (set! l-name (read))
  (list in f-name l-name))
 
;; student adder
(define (stud-add) (set! stud-db (append stud-db (list (stud-make)))))
 
;; student remover
(define (stud-remove stud) (set! stud-db (remove stud stud-db)))
 
;; dump database
(define (dump) (printf ";current database ~a~n" stud-db))
 
;; main func
(define (main)
  (stud-add) (stud-add) (stud-add) (dump)
  (stud-remove '(1 иванов сергей)) (dump))
 
(main)
;index: 1
;first name: иванов
;last name: сергей
;index: 2
;first name: петров
;last name: петр
;index: 3
;first name: сидоров
;last name: сидр
;current database ((1 иванов сергей) (2 петров петр) (3 сидоров сидр))
;current database ((2 петров петр) (3 сидоров сидр))

@Catstail · 16.06.2014, 15:16

HomeLisp:

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
;; Добавить студента
 
(defmacro add-student (base n s)
  `(let ((num (if (null ,base) 1 (+ 1 (caar ,base)))))
    (push (list num ,n ,s) ,base)))
 
==> add-student
 
;; Показать по номеру
 
(defun show-by-num (base n)
  (dolist (p base 'Not_found)
    (when (= (car p) n) (printline p) (return 'ok))))
 
==> show-by-num
 
;; Удалить по номеру
 
(defmacro delete-by-num (base num)
  `(setq ,base (remove-if #'(lambda (x) (= (car x) ,num)) ,base))) 
 
==> delete-by-num
 
;; Создаем базу
 
(setq *base* nil)
 
==> NIL
 
Создана глобальная переменная *base*
 
(add-student *base* "Иванов" "Иван")
 
==> ((1 "Иванов" "Иван"))
 
(add-student *base* "Петров" "Петр")
 
==> ((2 "Петров" "Петр") (1 "Иванов" "Иван"))
 
(add-student *base* "Кошкин" "Олег")
 
==> ((3 "Кошкин" "Олег") (2 "Петров" "Петр") (1 "Иванов" "Иван"))
 
(add-student *base* "Мышкин" "Семен")
 
==> ((4 "Мышкин" "Семен") (3 "Кошкин" "Олег") (2 "Петров" "Петр") (1 "Иванов" "Иван"))
 
(Show-by-num *base* 2)
 
(2 "Петров" "Петр")
 
==> ok
 
(delete-by-num *base* 2)
 
==> ((4 "Мышкин" "Семен") (3 "Кошкин" "Олег") (1 "Иванов" "Иван"))
 
(delete-by-num *base* 2)
 
==> ((4 "Мышкин" "Семен") (3 "Кошкин" "Олег") (1 "Иванов" "Иван"))
 
(delete-by-num *base* 3)
 
==> ((4 "Мышкин" "Семен") (1 "Иванов" "Иван"))
 
(show-by-num *base* 2)
 
==> Not_found

@ывац422м · 17.06.2014, 13:56 **[ТС]**

Вроде разобрался, спасибо!

@Catstail · 17.06.2014, 15:01

База - так база - код ниже:

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

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
(prog nil
 
      (try (dlgDestroy '_Dlg_) except Nil)
      (dlgCreate '_Dlg_ 427 287 "База данных студентов" &H8000000F)
      (dlgAddControl '_Dlg_ '_BUT_1 _BUTTON 11 70 90 50 '("Tahoma" 8,25 1 0 0) "Добавить")
      (dlgAddControl '_Dlg_ '_BUT_2 _BUTTON 113 70 90 50 '("Tahoma" 8,25 1 0 0) "Удалить")
      (dlgAddControl '_Dlg_ '_BUT_3 _BUTTON 217 70 90 50 '("Tahoma" 8,25 1 0 0) "Найти")
      (dlgAddControl '_Dlg_ '_BUT_4 _BUTTON 317 70 90 50 '("Tahoma" 8,25 1 0 0) "Закрыть")
      (dlgAddControl '_Dlg_ '_TXT_1 _TEXT 15 21 390 38 '("Tahoma" 16 1 0 0) "" 0 &H80000008 &H80000005)
      (dlgAddControl '_Dlg_ '_LST_1 _LIST 13 129 393 107 '("Tahoma" 11 1 0 0) &H80000008 &H80000005)
      ;;
      ;; Пролог загрузки диалога _DLG_
      ;;
      (Prog (dsn sql)
       (unless (filExistp "students.dbf")
        (comCreateObject 'Conn  "ADODB.Connection" )
        (comCreateObject 'RS    "ADODB.Recordset"  )
        (setq DSN (strCat "DRIVER=Microsoft Dbase Driver (*.dbf);DBQ=" (sysHome)))
        (comMethod 'Conn "open" DSN)
        (setq sql "create table students (Name char(50), Surname char(50))")
        (comMethod 'RS "open" sql 'Conn 3 3)
        (comMethod 'Conn "close"))))
        (comDestroyObject 'Rs)
        (comDestroyObject 'Conn)
      ;;   
      ;; Обработчик события CLICK для кнопки _BUT_1
      ;;
      (defun _BUT_1_Click  Nil
        (prog (txt nam sur dsn sql tmp)
           (setq txt (strATrim (dlgGetText '_TXT_1 -1)))
           (if (zerop (strLen txt)) 
               (say "Введите имя и фамилию")
               (progn 
                 (setq tmp (strWords txt))
                 (setq nam (car tmp))
                 (setq sur (cadr tmp))
                 (comCreateObject 'Conn  "ADODB.Connection" )
                 (comCreateObject 'RS    "ADODB.Recordset"  )
                 (setq DSN (strCat "DRIVER=Microsoft Dbase Driver (*.dbf);DBQ=" (sysHome)))
                 (comMethod 'Conn "open" DSN)
                 (setq sql (strCat "insert into students values ('" nam "','" sur "')"))
                 (comMethod 'RS "open" sql 'Conn 3 3)
                 (comMethod 'Conn "close")
                 (comDestroyObject 'Rs)
                 (comDestroyObject 'Conn)
                 (say "OK")
               ))))
      ;;
      ;;   Назначение процедуры-события _BUT_1_Click  контролу _BUT_1
      ;;
      (dlgSetEvent '_BUT_1 '_BUT_1_Click )
      ;;   
      ;; Обработчик события CLICK для кнопки _BUT_2
      ;;
      (defun _BUT_2_Click  Nil
        (prog (txt dsn sql res n)
           (setq txt (strATrim (dlgGetText '_TXT_1 -1)))
           (if (zerop (strLen txt)) 
               (say "Введите строку удаления")
               (progn 
                 (comCreateObject 'Conn  "ADODB.Connection" )
                 (comCreateObject 'RS    "ADODB.Recordset"  )
                 (setq DSN (strCat "DRIVER=Microsoft Dbase Driver (*.dbf);DBQ=" (sysHome)))
                 (comMethod 'Conn "open" DSN)
                 (setq sql (strCat "delete from students where Name like '%" txt "%' or Surname like '%" txt "%'")) 
                 (comMethod 'RS "open" sql 'Conn 3 3)
                 (comMethod 'Conn "close")
                 (comDestroyObject 'Rs)
                 (comDestroyObject 'Conn)
               ))))
      ;;
      ;;   Назначение процедуры-события _BUT_2_Click  контролу _BUT_2
      ;;
      (dlgSetEvent '_BUT_2 '_BUT_2_Click )      
      ;;   
      ;; Обработчик события CLICK для кнопки _BUT_3
      ;;
      (defun _BUT_3_Click  Nil
        (prog (txt dsn sql res n)
           (setq txt (strATrim (dlgGetText '_TXT_1 -1)))
           (if (zerop (strLen txt)) 
               (say "Введите строку поиска")
               (progn 
                 (comCreateObject 'Conn  "ADODB.Connection" )
                 (comCreateObject 'RS    "ADODB.Recordset"  )
                 (setq DSN (strCat "DRIVER=Microsoft Dbase Driver (*.dbf);DBQ=" (sysHome)))
                 (comMethod 'Conn "open" DSN)
                 (setq sql (strCat "select * from students where Name like '%" txt "%' or Surname like '%" txt "%'")) 
                 (comMethod 'RS "open" sql 'Conn 3 3)
                 (setq n (comPropGet 'Rs "RecordCount"))
                 (if (zerop n)
                     (say "Ничего не найдено!")
                     (progn
                       (dlgClearList '_LST_1)
                       (loop
                          (if (comPropGet 'Rs "eof")  
                              (return nil)
                              (progn
                                (setq res (cons (strCat (comPropGet 'Rs "" 0) " " (comPropGet 'Rs "" 1)) res))
                                (comMethod 'Rs "movenext")))) 
                       (dlgPutList '_LST_1 res)))                                            
                 (comMethod 'Conn "close")
                 (comDestroyObject 'Rs)
                 (comDestroyObject 'Conn)
               ))))
      ;;
      ;;   Назначение процедуры-события _BUT_3_Click  контролу _BUT_3
      ;;
      (dlgSetEvent '_BUT_3 '_BUT_3_Click )
      ;;
      ;; Обработчик события CLICK для кнопки _BUT_4
      ;;
      (defun _BUT_4_Click  Nil 
         (dlgHide '_DLG_)
         (dlgDestroy '_DLG_)
      )
      ;;
      ;;   Назначение процедуры-события _BUT_4_Click  контролу _BUT_4
      ;;
      (dlgSetEvent '_BUT_4 '_BUT_4_Click )
      ;;
      ;;   Отображение диалога _Dlg_
      ;;
      (dlgShow '_Dlg_))

@Catstail · 19.06.2014, 15:22

Вот подправленные файлы:

@ывац422м · 19.06.2014, 19:57 **[ТС]**

Ого, это даже слишком круто! мы всей группой думали, преподаватель смеется над нами, говоря, что в Lisp можно сделать графический интерфейс)

А можете пожалуйста помочь с процедурой redakt??? Должна редактировать запись базы, в качестве аргумента передаем базу и номер редактируемой записи, в ходе работы процедура должна запросить новые значения

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
; Добавление
(defmacro add (base n s)
  `(let 
    ((num (if (null ,base) 1 (+ 1 (caar ,base)))))
    (push (list num ,n ,s) ,base)))
 
; Показать по номеру
(defun show-by-num (base n)
  (dolist (p base 'Net_elementa)
    (when 
        (= (car p) n) (print p) 
        (return 'ok))))
 
; Удалить по номеру
(defmacro delete-by-num (base num)
  `(setq ,base (remove-if 
             #'(lambda (x) 
            (= (car x) ,num)) ,base)))
 
; Редактирование записи
(defmacro redakt (base num)
 '(setq ,base (remove-if
    #'(lambda (x)
        (= (car x) ,num))
        ((setq n ,(read))
         (setq s ,(read)))
)))
 
; Создание базы
(setq *base* nil)
 
(add *base* "Иванов" "Иван")
(Show-by-num *base* 2)
(delete-by-num *base* 2)
(redakt *base* 3)

@Catstail · 19.06.2014, 20:24

Вот полный код:

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
;; Добавление
(defmacro add (base n s)
  `(let 
    ((num (if (null ,base) 1 (+ 1 (caar ,base)))))
    (push (list num ,n ,s) ,base)))
 
;; Показать по номеру
(defun show-by-num (base n)
  (dolist (p base 'Net_elementa)
    (when 
        (= (car p) n) (print p) 
        (return 'ok))))
 
;; Удалить по номеру
(defmacro delete-by-num (base num)
  `(setq ,base (remove-if 
             #'(lambda (x) 
            (= (car x) ,num)) ,base)))
 
;; Редактирование записи 
 
(defun edit-by-num (base num)
  (dolist (el base 'Not_found)
    (when (= (car el) num)
       (let ((su (progn (printsline "Фамилия:") (read)))
             (na (progn (printsline "Имя:") (read))))
          (rplaca (cdr el) su)
          (rplaca (cddr el) na)
          (return 'ok)))))          
 
 
;; Создание базы
 
(setq *base* nil)
 
;; Наполнение
 
(add *base* "Иванов" "Иван")
(add *base* "Петров" "Петр")
(add *base* "Кошкин" "Михаил")
 
;; Разное
 
(Show-by-num *base* 2)
(delete-by-num *base* 2)
 
(edit-by-num *base* 3)

@helter · 19.06.2014, 20:53

Сообщение от Catstail

(defmacro add (base n s) `(let ((num (if (null ,base) 1 (+ 1 (caar ,base))))) (push (list num ,n ,s) ,base)))

А что вы не загенсимили num? Будет неправильно работать, если, например, одним из параметров будет переменная num. delete-by-num по той же причине может неправильно работать:

Lisp
1
2
(let ((x 2))
  (delete-by-num *base* x))

@Catstail · 19.06.2014, 22:42

Сообщение от helter

А что вы не загенсимили num?

- прокол...

Добавлено через 1 час 6 минут
Правильнее так:

Lisp
1
2
3
4
5
6
7
8
9
10
11
(defmacro add (base n s)
 (let ((num (gensym 'num)))
  `(let 
    ((num (if (null ,base) 1 (+ 1 (caar ,base)))))
    (push (list num ,n ,s) ,base))))
 
(defmacro delete-by-num (base num)
 (let ((x (gensym 'x)))
  `(setq ,base (remove-if 
             #'(lambda (,x) 
            (= (car ,x) ,num)) ,base))))

@helter · 20.06.2014, 00:10

Catstail, а у вас есть защита стандартной библиотеки от переопределений? И/или что-нибудь типа пакетов?

@Catstail · 20.06.2014, 14:11

Пакетов нет... Стандартную функцию (типа SUBR/FSUBR) переопределить нельзя. Остальные можно.

@helter · 20.06.2014, 14:25

Сообщение от Catstail

Пакетов нет... Стандартную функцию (типа SUBR/FSUBR) переопределить нельзя. Остальные можно.

А, это хорошо. Потому что иначе макросы добавляли бы кучу неявных зависимостей: каждый незагенсимленный символ был бы подвержен захвату.

Новые блоги и статьи Все статьи Все блоги /
Модульный подход на примере F# DevAlt 06.03.2026 В блоге дяди Боба наткнулся на такое определение: В этой книге («Подход, основанный на вариантах использования») Ивар утверждает, что архитектура программного обеспечения — это структуры,. . .	Управление камерой с помощью скрипта OrbitControls.js на Three.js: Вращение, зум и панорамирование 8Observer8 05.03.2026 Содержание блога Финальная демка в браузере работает на Desktop и мобильных браузерах. Итоговый код: orbit-controls-threejs-js. zip. Сканируйте QR-код на мобильном. Вращайте камеру одним пальцем,. . .	SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D 8Observer8 04.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .	SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий 8Observer8 02.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip Сканируйте QR-код на мобильном и вы увидите, что появится джойстик для управления главным героем. . . .
Реалии Hrethgir 01.03.2026 Нет, я не закончил до сих пор симулятор. Эта задача сложнее. Не получилось уйти в плавсостав, но оно и к лучшему, возможно. Точнее получалось - но сварщиком в палубную команду, а это значит, в моём. . .	Ритм жизни kumehtar 27.02.2026 Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .	SDL3 для Web (WebAssembly): Сборка библиотек: SDL3, Box2D, FreeType, SDL3_ttf, SDL3_mixer и SDL3_image из исходников с помощью CMake и Emscripten 8Observer8 27.02.2026 Недавно вышла версия 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual Studio. . . .	SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .

База студентов

Решение

Решение

@ывац422м 0 / 0 / 0 Регистрация: 23.02.2013 Сообщений: 18

	База студентов 16.06.2014, 12:50. Показов 1385. Ответов 12 Метки нет (Все метки) Добрый день! Помогите написать базу студентов, самую простую, должна быть реализована с помощью списков и должна выполнять добавление, вывод всего списка и удаление элемента. Пользователь вводит номер студента, имя и фамилию. Спасибо заранее! 0

@ывац422м 0 / 0 / 0 Регистрация: 23.02.2013 Сообщений: 18
	17.06.2014, 13:56 [ТС]
	Вроде разобрался, спасибо! 0

@helter 4528 / 3522 / 358 Регистрация: 12.03.2013 Сообщений: 6,038
	20.06.2014, 00:10
	Catstail, а у вас есть защита стандартной библиотеки от переопределений? И/или что-нибудь типа пакетов? 0

@Catstail Супер-модератор 38178 / 21113 / 4307 Регистрация: 12.02.2012 Сообщений: 34,716 Записей в блоге: 14
	20.06.2014, 14:11
	Пакетов нет... Стандартную функцию (типа SUBR/FSUBR) переопределить нельзя. Остальные можно. 0