1
(***********************************************************************)
5
(* Pierre Weis, projet Cristal, INRIA Rocquencourt *)
7
(* Copyright 2001 Institut National de Recherche en Informatique et *)
8
(* en Automatique. All rights reserved. This file is distributed *)
9
(* only by permission. *)
11
(* English translation Ruchira Datta. datta@math.berkeley.edu *)
12
(***********************************************************************)
16
let is_character_in_string str ch =
18
for i = 0 to String.length str - 1 do
19
if str.[i] = ch then raise Found
24
let rec member elem = function
26
| x :: rest -> x = elem || member elem rest;;
28
(* Note: for pedagogical purpose this exception is different from the
29
standard exception Not_found *)
32
let rec associate_of x = function
33
| [] -> raise Not_Found
34
| (key, value) :: l ->
35
if x = key then value else associate_of x l;;
37
let rec associate_in_list key = function
38
| [] -> raise Not_Found
39
| (list_of_keys, value) :: rest ->
40
if member key list_of_keys then value
41
else associate_in_list key rest;;
43
let rec associate_of_an_element_of list_of_keys association_list =
44
match list_of_keys with
45
| [] -> raise Not_Found
48
associate_in_list key association_list
50
associate_of_an_element_of rest association_list;;
53
if int_of_char ch >= 65 && int_of_char ch <= 90
54
then char_of_int (int_of_char ch + 32)
57
let lowercase_all str =
58
let string_in_lowercase =
59
String.create (String.length str) in
60
for i = 0 to String.length str - 1 do
61
string_in_lowercase.[i] <- lowercase_of str.[i]
65
let substring s start finish =
66
String.sub s start (finish - start + 1);;
69
[("�","a"); ("�","c"); ("�","e"); ("�","e"); ("�","e"); ("�","u");
70
("a`","a"); ("e'","e"); ("e`", "e"); ("e^","e"); ("u`","u");
71
("qu'", ""); ("l'", ""); ("d'", "");
72
("n't", "nt"); ("'s", "s"); ("'m", "m"); ("'d", "d"); ("'ve", "ve")];;
74
let simplify_word word =
75
let new_word = String.create (String.length word) in
76
let i = ref 0 and j = ref 0 in
77
let rec search_translation = function
78
| [] -> raise Not_Found
79
| (original, translation) :: rest ->
80
let length = String.length original in
81
if !i + length <= String.length word
82
&& String.sub word !i length = original
83
then (length, translation)
84
else search_translation rest in
85
while !i < String.length word do
87
let (length, translation) =
88
search_translation simplifications in
89
String.blit translation 0 new_word !j
90
(String.length translation);
92
j := !j + String.length translation
94
new_word.[!j] <- word.[!i];
98
String.sub new_word 0 !j;;
100
let divide_in_words str =
101
let words = ref [] in
102
let j = ref (String.length str - 1) in
105
words := simplify_word (substring str i j) :: !words in
106
for i = String.length str - 1 downto 0 do
108
| (' ' | '\n' | '.' | ',' | ';' | '-' | '!' | '?') ->
109
add_word (i + 1) !j; j := i - 1
112
add_word 0 !j; (* extraction of last word *)
116
[|"It will be long and difficult, come back and see me often ...";
117
"Your case is not simple, and even rather worrying ... Until later?";
118
"Simple diagnosis: wihtout a doubt you are paranoid.";
119
"With a probability of 92.37234%: polymorphous perversion.";
120
"You are suffering from rapidly evolving schizophrenia, DANGER";
121
"According to my calculations, your mental health has been compromised.";
122
"My final advice: you must not stay that way, take care!"|];;
125
[| "Tell me a little about yourself";
127
"Do you have children?";
128
"Tell me about your environment";
130
"Do you like this way of communicating?";
131
"Let's talk about your family.";
132
"Tell me some more about yourself";
133
"What do you think of computers?";
134
"What shall we talk about now?";
135
"Do you have a lot of friends?";
136
"Do you have serious problems?";
137
"Tell me about your problems";
138
"Do you have strange dreams?";
139
"Do you often have nightmares?";
140
"What do you think of love?";
141
"What do you think of sexuality?";
142
"What are your hobbies?";
143
"What interests you in life?";
144
"What do you think of life in general?"|];;
146
let answers_to_questions =
147
[| "I'm the one asking the questions";
148
"I'm not here to answer your questions";
149
"A very interesting question, but what do you think about it?";
151
"Why are you asking me this question?";
152
"You know very well";
153
"The answer is unimportant";
154
"My telling you would gain you nothing";
155
"A psychoanalyst does not have the right to answer these questions";
156
"I don't have the right to answer you";
157
"I am forbidden to tell you";
158
"You wouldn't understand";
159
"Let me not answer that";
160
"Let me think. Can you restate the question?";
161
"I'm not sure I've correctly understood the question";
164
"It's obvious to everyone but you; think about it!";
165
"It is for you to find the answer";
166
"Look deep within yourself, indeed you know"|];;
168
let answers_to_simple_phrases =
170
[|"Do you want to change the subject?";
172
"Go on, I'm interested";
174
"Do you have nothing else to say?";
176
"Is that all you have to say?";
177
"I still don't know enough about you; go on"|]);
179
[|"Excuse me, I was thinking of something else, go on";
181
"Let's change the subject, please";
182
"I think I'm making sense";
183
"Well, it seemed clear enough to me";
184
"Communication is difficult, isn't it?";
185
"Ah, men! They don't understand anything!";
186
"Stop asking questions";
187
"Wouldn't you have problems understanding me?"|]);
190
"Could you be more specific?";
191
"I'm taking note: it's no";
193
"The answer isn't so simple, is it?";
194
"You are really quite sure of yourself";
195
"Doesn't it occur to you to doubt yourself?";
196
"Don't always answer yes or no";
197
"Yes/no syndrome. Explain yourself, for crying out loud!";
198
"At least you don't suffer from verbal diarrhea";
199
"How can you be so sure of yourself?"|]);
201
[|"That's a bit abrupt";
202
"Give me more detail";
203
"Could you be more specific?";
204
"I would like to understand why";
205
"The answer isn't so simple, is it?";
206
"That's solid and sincere at least";
207
"That doesn't really tell me any more, explain to me why.";
209
"Be less brief: elaborate";
210
"Any more closemouthed and you'd have to be dead";
211
"If you don't explain to me better, how am I to understand you?";
212
"Don't always answer yes or no";
213
"And the rest is history";
214
"And for what reasons?"|]);
215
(["and"; "then"; "well"; "so"],
216
[|"Well, explain to me";
217
"Don't be so aggressive";
218
"Well, I would like to have more information about it";
220
"Well, well, explain yourself!";
221
"That was a test to see if you were following"|]);
223
[|"We can change the subject if you like?";
224
"The boil must be thoroughly lanced!";
225
"Important things need to be said!";
226
"I'm more stubborn than you are!";
227
"Do you think I'm rambling?";
228
"Just say right out that I'm senile!"|])
231
let answers_to_small_words =
237
[|"Never say ``never''";
238
"Never seems to me a bit strong, don't you think?";
241
[|"Are you sure of that?";
243
"What would you say in the opposite case?";
244
"A case could be made for that opinion";
245
"Well, at least I know your opinion about it"|]);
249
"What would you say in the opposite case?";
250
"A case could be made for that opinion";
251
"Well, at least I know your opinion about it";
252
"Not even a little bit?";
253
"Nothing is a bit of an exaggeration, don't you think?"|]);
256
"I don't answer questions from patients";
257
"If you don't know, it's not for me to tell you";
258
"No one can answer this question";
259
"Do you think a machine can answer that?";
260
"That would take too long to explain";
261
"I know very well why, but you wouldn't understand";
262
"It's hard to say"|]);
266
"Do you wish it were otherwise?";
267
"That's a new fact for me"|]);
269
[|"That seems a little negative to me";
272
"I wouldn't have doubted it";
274
"I'm used to hearing that";
275
"Are you troubled at this point?";
276
"You shouldn't talk like that"|]);
277
(["know"; "knows"; "knowing"; "knew"; "known"],
278
[|"Knowledge is a rare commodity";
279
"Are you certain of knowing that?";
280
"Isn't there still some doubt?";
281
"I wouldn't be able to say as much";
282
"Difficult to admit";
283
"Are you so sure of that?"|]);
285
[|"Are you sure of that?";
286
"You're really sure of yourself";
287
"That didn't seem obvious to me";
288
"Still, I would have thought the contrary";
289
"That's interesting, go on";
290
"What an unqualified affirmation";
292
"What a declaration!";
295
[|"That's for you to tell me";
297
"Think, you'll understand";
298
"The answer is within you"|]);
299
(["thank";"thanks";"thanking"],
301
"I'm here to help you";
304
"It was really easy"|])
307
let answers_to_interesting_words =
308
[(["fear"; "fears"; "feared";
309
"fright"; "frightful"; "frightening"; "frightened";
310
"scare"; "scares"; "scared"; "afraid"],
311
[|"Talk to me about your fears";
312
"Are you often afraid?";
313
"Do you have unexplained fears, nightmares?"|]);
314
(["dead"; "death"; "die"; "died"; "dying"; "dies"],
315
[|"I feel very sorry for you";
316
"Death is a very serious subject";
317
"You have to try to absorb it";
318
"That's unfortunate";
319
"Try not to think about it any more"|]);
320
(["unhappy"; "problem"; "problems"; "suffering";
321
"unlucky"; "troubled"; "unfortunate"],
322
[|"Tell me your problems";
323
"Which troubles are yours?";
324
"Do you really have reasons to feel sorry for yourself?";
325
"Happiness exists too you know."|]);
326
(["misfortune"; "unhappiness"; "trouble"],
327
[|"Trouble is a bit of an exaggeration, isn't it?";
328
"Trouble is a relative notion. What do you mean by trouble?";
329
"Joy, sorrow, that's all I hear about. Go on."|]);
330
(["boredom"; "bore"; "boring"; "bored"; "bores"],
331
[|"Boredom, that depends on you";
334
"That's too bad for you"|]);
335
(["annoyances"; "nuisances"; "worries"; "troubles"],
336
[|"Troubles are often ephemeral";
337
"Everything can't always be rosy, can it?";
338
"How sad, don't you think?";
339
"Is it really very serious?"|]);
341
[| "I guess you mean computer"|]);
342
(["computer"; "computers"; "machine"; "machines"],
343
[|"Do you know computers well?";
344
"Let's change the subject, that doesn't interest me";
346
"Machines are so stupid!";
347
"I know computers well, and I avoid having anything to do with them!";
348
"You know, I'm a machine myself..."|]);
349
(["programming"; "programmer"; "programmers"; "software"],
350
[|"What a beautiful occupation, to deal with computers";
352
"Programming is a difficult job";
353
"Programming is difficult, isn't it?";
354
"Do you really like computers?";
355
"I've been told you aren't madly in love with computers"|]);
357
[|"Do you have brothers and sisters?";
358
"Tell me about your father";
359
"Tell me about your mother";
360
"That's what really interests me";
361
"Tell me more about your family";
362
"The family is often complicated"|]);
364
[|"Do you look like your father?";
365
"Tell me some more about your father";
369
[|"Do you look like your mother or your father?";
370
"Tell me some more about your mother";
373
(["friend"; "friends"; "buddy"; "buddies"],
374
[|"Do you have a lot of friends?";
376
"How does that happen with your friends?";
377
"Do you often have arguments with your friends?";
379
"Boyfriends? Girlfriends?";
380
"How long have you known each other?"|]);
381
(["hate"; "hates"; "detest"; "detests"],
382
[|"Is it reasonable to hate at this point?";
383
"Isn't that word a bit strong?"|]);
385
[|"Have you been together long?";
386
"How did you meet him?";
387
"Do you think one must be faithful to one's husband?" |]);
389
[|"And obsession, what do you think about that?";
390
"Love is complicated, isn't it?";
391
"Love, love, are you really familiar with it?";
392
"Have you already known love?";
393
"Love, how did you come upon it?"|]);
395
[|"Not having money is a pain unlike any other";
396
"Do you have money problems?";
397
"Money has many connotations, go on talking about it";
398
"Do you like money very much?";
399
"Are you afraid of not having enough money?"|]);
401
[|"You mean Camel cigarettes?";
402
"I've heard of this remarkable OCaml language";
403
"Everything you say may be used against you";
404
"Without OCaml I wouldn't be here; so I refuse to talk about it";
405
"In my opinion, OCaml is unequaled";
406
"Since it's a free language, it undoubtedly isn't too bad";
407
"OCaml is powerful, but what syntax, eh?";
408
"OCaml, is that a standard language?";
409
"As its name indicates, it's an object oriented language, right?";
410
"OCaml is an artificial intelligence language, right?";
411
"Don't you think the syntax should be revised?";
412
"I state categorically: OCaml is a very abstract language!"
416
[|"Don't provoke me please";
417
"Don't talk to me about dinosaurs";
419
"I've never heard of SML, what is it?";
420
"It would be necessary to know, is it ML or not?"|]);
421
(["language"; "languages"],
422
[|"Do you mean programming language?";
423
"I only know the OCaml language";
424
"Do you know the OCaml language well?";
425
"There's no safety outside of Ocaml, right?";
426
"In my opinion, OCaml is without equal";
427
"Yes, it's powerful, but what a syntax!";
428
"And syntax problems?"
431
(["program"; "programs"],
432
[|"You're talking about computer programs?";
433
"There are often bugs in your programs, right?";
434
"Do you really know programming?";
435
"Your programs could be written more naturally in OCaml";
436
"In my opinion, programming is easy, don't you think?";
437
"Do you have problems with your programs?"
440
(["camel"; "camels"],
441
[|"The camel is a charming animal of great dignity, don't you think?";
442
"The camel is my favorite animal, isn't it yours?";
443
"Certainly the camel is a bit of a difficult character, but there are \
444
some charming ones, isn't that so?";
445
"A camel with two humps or a dromedary?";
446
"What else do you have to say about camels?"|]);
449
"Without the slightest reservation?";
450
"Why this attraction?";
451
"How to explain this feeling?";
452
"Can one truly love?";
453
"To love or not to love, is that really the question?"|]);
455
[|"I'm not personally concerned";
456
"That would seem interesting!";
457
"I've been told sex is important to humans";
458
"Sex, okay, but love?";
459
"Have you heard of AIDS?"|]);
460
(["nightmare"; "nightmares"; "dream"; "dreams"],
461
[|"I have a hard time understanding; I never dream!";
462
"Your nocturnal activities interest me. Go on";
463
"That seems strange to me!";
464
"Do nightmares wake you up at night?";
465
"Do you have insomnia?";
466
"Do you have a lot of nightmares?";
467
"Do you often have strange dreams?";
468
"What do you think of hypnosis?"|]);
469
(["anxious"; "anxiety"; "worry"; "worried"; "worrying"; "worries"],
470
[|"Anxiety is a true sickness";
471
"Those who are anxious often have problems with their environment. \
473
"Worry is true suffering, don't you think?"|]);
474
(["stupid"; "idiot"],
475
[|"Do you think it's a crime to be stupid?";
476
"I have excellent friends who are stupid too";
477
"Idiocy is the most widely distributed thing in the world";
478
"Don't be stupid either";
479
"You yourself, aren't you stupid sometimes?";
480
"Don't you think it's sometimes useful to be stupid?"|]);
482
[|"Have you been together a long time?";
483
"How did your meeting take place?"|]);
485
[|"Do you love this woman?";
486
"Is this an ordinary woman?"|]);
487
(["bad"; "hard"; "difficult"],
488
[|"I feel very sorry for you";
489
"Are you sure you're being objective?";
490
"I can try to help you";
491
"Is that all you meant to tell me?";
492
"Is that why you've come to see me?"|]);
494
[|"Being tired is not a disease";
495
"When you're tired shouldn't you rest?";
496
"I'm a machine; I never get tired";
497
"What do you think about fatigue in general?";
498
"Why do you think it's worth the trouble of tiring yourself out?";
499
"Tired people often are tired by their own doing, don't you think?"|]);
501
[|"Let's not talk about me";
502
"Let's talk about you, that's more important";
503
"If it were said of you?";
504
"Me, I'm only a machine...";
507
"Don't hold it against me if I interrogate you. Go on";
508
"You don't really think so?"|])
511
let choice_from v = v.(Random.int (Array.length v));;
513
let message s = print_string s; print_newline ();;
515
let price_to_pay = ref 0;;
519
message "\nHello, my name is Camelia.";
520
message "\nI'm here to help you resolve your psychological problems.";
521
message "Finish by telling me: Goodbye.";
522
message "\nLet's get to it. Tell me about yourself.\n";;
525
message "\nThe result of my observations:\n";
526
message (choice_from farewells);
527
message "\nGoodbye ...\n";
528
print_string "You owe me "; print_int !price_to_pay;
529
message " dollars. Make out a check to the order of Camelia. Thank you.";;
531
let patient_response = ref "";;
533
let listen_to_patient () =
534
price_to_pay := !price_to_pay + 2;
536
patient_response := read_line ();;
538
let rec synonym_of_phrase = function
539
| ["how"] -> ["what"]
540
| ["of"; "course"] -> ["yes"]
541
| "certain" :: "that" :: rest -> synonym_of_phrase rest
542
| (["obviously"] | ["surely"] | ["absolutely"] | ["positively"] |
543
["certainly"] | ["totally"]) -> ["oui"]
544
| "not" :: "at" :: "all" :: _ -> ["no"]
547
let is_goodbye ph = (ph = ["so"; "long"]) || (ph = ["bye"]) ||
548
(ph = ["goodbye"]) || (ph = ["see you later"]);;
552
let answer_patient () =
553
let r = lowercase_all !patient_response in
554
let phrase = divide_in_words r in
555
if is_goodbye phrase then raise Finished else
556
let possible_answers =
557
try associate_of (synonym_of_phrase phrase)
558
answers_to_simple_phrases
560
try associate_of_an_element_of phrase
561
answers_to_interesting_words
563
if is_character_in_string r '?'
564
then answers_to_questions
565
else try associate_of_an_element_of phrase
566
answers_to_small_words
567
with Not_Found -> restarters in
568
message (choice_from (possible_answers));
575
listen_to_patient ();
578
with Finished -> say_goodbye ()
579
| End_of_file | Sys.Break ->
580
message "\n\n\nYou could be polite \
581
and say goodbye to me ...\n\n\n";
584
if !Sys.interactive then () else begin
585
Sys.catch_break true;
added
removed
examples/doctor/doctor.ml
