home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol163 / bibsr2.bas < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  6.2 KB  |  218 lines
  1.     REM -------FILE BIBSR2.BAS
  2.  
  3.     REM SEGMENT TWO OF BIBLIOGRAPHY SEARCH PROGRAM
  4.     COMMON KEYWD$(1),LIBNAME$,RLEN%,TRUE%,AUTH.LEN5,TITL.LEN%
  5.     COMMON MAXBIB%,MAXDESC%,MAXDEF%,MAXKEYS%,MAXCON%,CONCEPT$(1)
  6.     COMMON ISS.LEN%,CLS$,ERR%,JOUR.LEN%,KWD,LEN%,CMD$(1)
  7.     COMMON LFT%(1),RGHT%(1),CON.KEY%(2),CON.RATE(2),QUERY$,L%
  8.  
  9.     DIM OP.STK$(MAXCON%),V.STK(MAXCON%), ART.KEY%(MAXDESC%)
  10.     DIM RPT%(11), ART.VAL(MAXDESC%),V(MAXCON%),RATING%(MAXBIB%)
  11.  
  12.     REM FUZZY LOGICAL FUNCTIONS
  13.     DEF FN.ZADEH(A,B,CH$)
  14.     ERR%=0
  15.     IF CH$="*" THEN 4E1
  16.     IF CH$="*" THEN 4.1E1
  17.     IF CH$<>"*" THEN FN.ZADEH=0 : ERR%=3 : RETURN
  18.     IF B>(1.0-A) THEN FN.ZADEH=B ELSE FN.ZADEH=1.0-A
  19.     RETURN
  20.  
  21.     REM CONVERT TWO ASCII HEX TO INTEGER
  22.     DEF FN.TWO.INT%(DUM$)
  23.     TEN%=ASC(MID$(DUM$,1,1))
  24.     IF TEN%>64 THEN TEN%=TEN%-55 ELSE TEN%=TEN%-48
  25.     ONE%=ASC(MID$(DUM$,2,1))
  26.     IF ONE%>64 THEN ONE%=ONE%-55 ELSE ONE%=ONE%-48
  27.     FN.TWO.INT%=16*TEN%+ ONE%
  28.     RETURN
  29.     FEND
  30.  
  31.     REM CONVERT ONE ASCII HEX TO REAL
  32.     DEF FN.ONEREAL(DUM$)
  33.     ONE%=ASC(MID$(DUM$,3,1))
  34.     IF ONE%>64 THEN ONE%=ONE%-55 ELSE ONE%=ONE%-48
  35.     FN.ONEREAL=ONE%/10.0
  36.     RETURN
  37.     FEND
  38.  
  39. 4E1     IF A<B THEN FN.ZADEH=A ELSE FN.ZADEH=B
  40.     RETURN
  41.  
  42. 4.1E1   IF A>B THEN FN.ZADEH=A ELSE FN.ZADEH=B
  43.     RETURN
  44.     FEND
  45.  
  46.     GOSUB 19E1
  47.     CHAIN "BIBLIO"
  48.     STOP
  49.  
  50. 3E1     REM BUILD STRING Y$ FROM QUERY$ BY REPLACING CONCEPT
  51.     REM NAMES WITH THEIR VALUES
  52.     Y$="" : Y$=LEFT$(QUERY$,LFT%(1)-1):LFT%(L%+1)=LEN(QUERY$)+1
  53.     FOR I%=1 TO L%
  54.       V$=STR$(V(I%)):Y$=Y$+V$+MID$(QUERY$,RGHT%(I%),LFT%(I%+1)-RGHT%(I%))
  55.       NEXT I%
  56.     RETURN
  57.  
  58. 2E1     REM REDUCE Y$ BY PERFORMING FUZZY LOGICAL OPS
  59.     J%=1 : L1%=LEN(Y$)
  60.     IF LEFT$(Y$,1)<>"(" THEN RETURN
  61.     WHILE MID$(Y$,J%,1)<>")"
  62.       J%=J%+1 
  63.     WEND
  64.     I%=J%
  65.     WHILE MID$(Y$,I%,1)<>"("
  66.       I%=I%-1  
  67.     WEND
  68.     I%=I%+1:M%=I%:V.PTR%=MAXCON% : OP.PTR%=MAXCON%
  69.  
  70. 2.2E1   K%=M%
  71.     WHILE (ASC(MID$(Y$,K%,1))>=44)
  72.       K%=K%+1  
  73.     WEND
  74.     V.STK(V.PTR%)=VAL(MID$(Y$,M%,K%-M%)):V.PTR%=V.PTR%-1
  75.     IF K%-J% THEN 2.1E1
  76.     OP.STK$(OP.PTR%)=MID$(Y$,K%,1):OP.PTR%=OP.PTR%-1:M%=K%+1:GOTO 2.2E1
  77.  
  78. 2.1E1   WHILE OP.PTR%<MAXCON%
  79.       OP.PTR%=OP.PTR%+1 : OP$=OP.STK$(OP.PTR%)
  80.       V.PTR%=V.PTR%+1   : V1=V.STK(V.PTR%)
  81.       V.PTR%=V.PTR%+1   : V2=V.STK(V.PTR%)
  82.       T=FN.ZADEH(V1,V2,OP$)
  83.       IF ERR% THEN RETURN
  84.       V.STK(V.PTR%)=T  :  V.PTR%=V.PTR%-1
  85.       WEND
  86.     V.PTR%=V.PTR%+1  :  V1=V.STK(V.PTR%)
  87.     IF MID$(Y$,J%+1,1)="'" THEN V1=1.0-V1 : \
  88.       Y$=LEFT$(Y$,I%-2)+STR$(V1)+RIGHT$(Y$,L1%-J%-1) \
  89.       ELSE Y$=LEFT$(Y$,I%-2)+STR$(V1)+RIGHT$(Y$,L1%-J%):GOTO 2E1
  90.     RETURN
  91.  
  92. 19E1    REM READ IN BIBLIO AND CALCULATE SATISFACTION LEVELS
  93.     IF END #2 THEN 20.1E1
  94.     BIB.LEN%=0 : DESC.BEG%=AUTH.LEN%+TITL.LEN%+JOUR.LEN%+ISS.LEN%+1
  95.     OPEN LIBNAME$+".BIB" AS 2 BUFF 16 RECS 128
  96.     READ #2; LINE BUFF$
  97.     WHILE TRUE%
  98.       READ #2; LINE BUFF$
  99.       BIB.LEN%=BIB.LEN%+1
  100.       IF LEFT$(BUFF$,5)="zzzzz" THEN RATING%(BIB.LEN%)=0 : GOTO 19.5E1
  101.       REM DECODE DESCRIPTORS
  102.       K%=DESC.BEG% : DESC.NO%=0
  103.       WHILE TRUE%
  104.         DUM$=MID$(BUFF$,K%,3)
  105.         IF DUM$="FFF" THEN 19.1E1
  106.         DESC.NO%=DESC.NO%+1:ART.KEY%(DESC.NO%)=FN.TWO.INT%(DUM$)
  107.         ART.VAL(DESC.NO%)=FN.ONEREAL(DUM$):K%=K%+3
  108.         WEND
  109.  
  110. 19.1E1  REM DETERMINE ARTICLE VALUE V(J%) FOR EACH CONCEPT
  111.     FOR J%=1 TO L%
  112.       KEY%=1 : MIN=1.0 : MAX=0.0
  113.       WHILE CON.KEY%(J%,KEY%)<>0
  114.         REM FIND MATCHING ART.KEY%
  115.         RAL=0.0
  116.         FOR I%=1 TO DESC.NO%
  117.           IF ART.KEY%(I%)=CON.KEY%(J%,KEY%) THEN RAL=ART.VAL(I%)
  118.           NEXT I%
  119.         IF RAL<CON.RATE(J%,KEY%) THEN MIN=RAL ELSE MIN=CON.RATE(J%,KEY%)
  120.         IF MIN>MAX THEN MAX=MIN
  121.         KEY%=KEY%+1
  122.         WEND
  123.       V(J%)=MAX
  124.       NEXT J%
  125.     GOSUB 3E1:GOSUB 2E1
  126.     IF ERR% THEN 22E1
  127.     RATING%(BIB.LEN%)=10*VAL(Y$)
  128.  
  129. 19.5E1  WEND
  130.  
  131. 20.1E1  CLOSE 2
  132.  
  133. 21E1    REM SEARCH OVER RATINGS TO COMPUTE *ARTICLES VS RATINGS
  134.     FOR I%=1 TO 11 : RPT%(I%)=0 : NEXT I%
  135.     FOR I%=1 TO BIB.LEN%:K%=RATING%(I%)+1:RPT%(K%)=RPT%(K%)+1:NEXT I%
  136.     FOR I%=10 TO 1 STEP -1:RPT%(I%)=RPT^(I%)+RPT^(I%+1):NEXT I%
  137.  
  138. 21.3E1  PRINT CLS$
  139.     PRINT TAB(11); "NUMBER OF ARTICLES THAT MEET OR EXCEED RATING OF"
  140.     PRINT TAB(28); "0.0.....1.0":PRINT
  141.     PRINT TAB(11);"RATINGS";TAB(22);"#ARTICLES";
  142.     PRINT TAB(39);"RATINGS";TAB(50);"#ARTICLES":PRINT
  143.     FOR I%=1 TO 6
  144.       FOR K%=0 TO 1
  145.         IND%=I%+6*K%
  146.         IF IND%>11 THEN 21.9E1
  147.         PRINT USING "#.#";TAB(13+28*K%); (IND%-1)/10.0;
  148.         PRINT USING "###"; TAB(24+28*K%); RPT%(IND%);
  149.         NEXT K%
  150.  
  151. 21.9E1  PRINT
  152.     NEXT I%:PRINT
  153.  
  154.     REM FIND AND LIST ARTICLES THAT MEET MINIMUM THRESHOLD
  155.     INPUT "ENTER MINIMUM RATING DESIRED FOR ARTICLE PRINTOUT: ";MINRAT
  156.     GOSUB 24E1
  157.     OPEN LIBNAME$+".BIB" RECL RLEN% AS 2
  158.     I%=0
  159.     IF END #2 THEN 21.2E1
  160.     WHILE I%<BIB.LEN%
  161.     I%=I%+1
  162.       IF RATING%(I%) < INT%(10.0*MINRAT) THEN 21.1E1
  163.       READ #2,I%+1; LINE BUFF$
  164.       GOSUB 25E1
  165.  
  166. 21.1E1  WEND
  167.  
  168. 21.2E1  CLOSE 2:CONSOLE
  169.     INPUT "DO YOU WISH TO RE-SEARCH WITH DIFFERENT THRESHOLD(Y/N) ";ANS$
  170.     IF UCASE$(LEFT$(ANS$,1))="Y" THEN 21.3E1
  171.     FOR I%=1 TO MAXCON% : OP.STK$(I%)="" : NEXT I%
  172.     RETURN
  173.  
  174. 22E1    PRINT "INVALID FUZZY OPERATOR IN INTERROGATION PHRASE"
  175.     INPUT "PRESS RETURN TO RESTART SEARCH ROUTINE "; LINE ANS$
  176.     CHAIN "BIBSRCH"
  177.  
  178. 24E1    REM PRINT OUTPUT HEADER INFO
  179.     INPUT "DO YOU WISH A PRINTED OUTPUT (Y/N)? "; PRNT$
  180.     IN%=1 : LLEN%=63
  181.     IF UCASE$(LEFT$(PRNT$,1))="Y" THEN LPRINTER:IN%=6:LLEN%=79
  182.         FOR IP%=1 TO 5:PRINT:NEXT IP%
  183.     PRINT TAB(21); "Fuzzy Search of Library "; LIBNAME$
  184.     PRINT TAB(IN%) ;
  185.     FOR IP%=1 TO 63 : PRINT "-"; : NEXT IP% : PRINT
  186.     PRINT TAB(IN%); "Interrogation Phrase :"
  187.     PRINT TAB(IN%+3); QUERY
  188.     PRINT TAB(IN%); "Interrogation Phrase Definitions :"
  189.     FOR IP%=1 TO L%
  190.       PRINT TAB(IN%+3) ; CONCEPT$(IP%) ; " : ";
  191.       PRINT CMD$(IP%)
  192.       NEXT IP%
  193.     PRINT TAB(IN%); "Selection Level : ";
  194.     PRINT USING "#.#"; MINRAT
  195.     PRINT TAB(IN%);
  196.     FOR IP%=1 TO 63 : PRINT "-"; : NEXT IP% : PRINT
  197.     LCNT%=L%+13:RETURN
  198.  
  199. 25E1    REM PRINT ARTICLE DATE
  200.     SP%=IN%+5
  201.     IF JOUR.LEN%>ISS.LEN% THEN SP%=SP%+JOUR.LEN% ELSE SP%=SP%+ISS.LEN%
  202.     IF LCNT%>57 THEN \
  203.            FOR IP%=1 TO 71-LCNT%:PRINT:NEXT IP%:LCNT%=LCNT%+5
  204.     PRINT TAB(IN%);"Record : ";
  205.     PRINT USING "####"; I%;
  206.     IF (SP%+11)>LLEN% THEN PRINT TAB(IN%);:LCNT%=LCNT%+1: \
  207.            ELSE PRINT TAB(SP%);
  208.     PRINT "Level : ";:PRINT USING "#.#"; RATING%(I%)/10.0
  209.     PRINT TAB(IN%); MID$(BUFF$,AUTH.LEN%+TITL.LEN%+1,JOUR.LEN%);
  210.     IF (SP+TITL.LEN%)>LLEN% THEN PRINT TAB(IN%); : LCNT%=LCNT%+1 : \
  211.          ELSE PRINT TAB(SP%)
  212.     PRINT MID$(BUFF$,AUTH.LEN%+1,TITL.LENT%)
  213.     PRINT TAB(IN%);MID$(BUFF$,AUTH.LEN%+TITL.LEN%+JOUR.LEN%+1,ISS.LEN%);
  214.     IF (SP%+AUTH.LEN%)>LLEN% THEN PRINT TAB(IN%); : LCNT%=LCNT%+1 : \
  215.          ELSE PRINT TAB(SP%);
  216.     PRINT LEFT$(BUFF$,AUTH.LEN%):PRINT:LCNT%=LCNT%+4:RETURN
  217.  
  218.