I already sent this to: "Todd S. Greene" <tgreene@usxchange.net>,
but forgot the list. Sorry!
Hi, Todd
You wrote to Vernon (in part):
> I'm not sure yet how to specify "terminators." I'm thinking of
> terminators as something that designates the end of the sequence of
> characters that are being used to calculate a value. Of course, the
> text that is fed into the program can be modified at will by the user
> for the purpose of adding in an arbitrarily chosen character designated
> as a terminator, such as, say, a tilde character. The program could
> then just be coded in such a way as to produce values of each of the
> character sequences between each terminator.
>
> To make things simpler (for coding), other alphabets could simple be
> "mapped" to the English alphabet (ASCII characters) in some arbitrary
> fashion, and so the user would still specify values for English letters
> in a table used in the configuration file, but the letters in this case
> would not really correspond to English letters for English words but
> would correspond to whatever non-English letter they are "standing in"
> for. Of course, whatever mapping like this is used must also be applied
> to the text that is to be fed into the program. (I've never coded for
> Unicode and anything outside of business data processing applications
> right in the U.S., so I've never had to think about considerations of
> dealing with non-English languages and text. Perhaps there is a simpler
> way of doing this that I just don't happen to know anything about.)
>
> These are just some of my initial thoughts as I start thinking about
> coding this.
You might be interested in the code and data tables I used (in Microsoft
Access 97 Basic):
Option Compare Database
Option Explicit
Function Parse(ByVal language As String, sentence As String, _
ByVal con As String) As Double
'*****************************************************************************
'Parses sentence written in letter codes (GreekLetter, HebrewLetter,
with
'blank delimiters) in language ("Greek", "Hebrew") into words. Each new
'word is stored in GreekWord, HebrewWord, calculating its NumLetters and
'LetterProduct. New sentence is stored in GreekSentence, HebrewSentence,
'calculating its NumLetters, NumWords, LetterProduct, WordProduct (the
last 2
'as natural logarithms), and the return value
(NumLetters*LetterProduct)/
'(NumWords*WordProduct). The relative deviation of the return value from
the
'value of the constant con is evaluated and a record stored in
Evaluation.
'Called from:
'Calls functions: Deviation, NewWord
'Database, module: X_prg.pgm, M_Numerics
'Date, author: 1.7.2001 PR, modif. 13.7.2001 PR
'*****************************************************************************
Dim i As Integer, k As Integer, kk As Integer, leng As Integer
Dim letS As Integer, numL As Integer, numLet As Integer, numWord As
Integer
Dim dev As Single
Dim letP As Double, letProd As Double, pars As Double, wordProd As
Double
Dim crit As String, sentenceTab As String, word As String
pars = 0#
numLet = 0
numWord = 0
letProd = 0#
wordProd = 0#
sentence = Trim(sentence)
If Len(sentence) < 1 Then Exit Function
sentenceTab = language & "Sentence"
crit = "CodeSentence='" & sentence & "'"
On Error GoTo ParseLanguage
i = DCount("CodeSentence", sentenceTab, crit)
On Error GoTo 0
If i = 0 Then
numLet = 0
numWord = 0
k = 0
leng = Len(sentence)
Do While k < leng
k = k + 1
kk = InStr(k, sentence, " ")
If kk = 0 Then kk = leng + 1
word = Trim(Mid(sentence, k, kk - k))
k = kk
If NewWord(language, word, numL, letS, letP) Then
numLet = numLet + numL
numWord = numWord + 1
letProd = letProd + letP
wordProd = wordProd + Log(CDbl(letS))
Else
Debug.Print "Parse error: word='" & word & "': illegal letter"
Exit Function
End If
Loop
'Return value = (numLetters*letterProduct) / (numWords*wordProduct)
' calculated in natural logarithms
pars = Exp(Log(CDbl(numLet)) + letProd - Log(CDbl(numWord)) -
wordProd)
dev = Deviation(language, sentence, con, pars)
Debug.Print "Value=" & CStr(pars) & ", deviation from " & con & ": "
& CStr(dev)
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO " & sentenceTab & "
(CodeSentence,NumLetters," _
& "NumWords,LetterProduct,WordProduct,Return) SELECT '" &
sentence & _
"' AS A1, " & numLet & " AS A2, " & numWord & " AS A3, '" & _
CStr(letProd) & "' AS A4, '" & CStr(wordProd) & "' AS A5, '" & _
CStr(pars) & "' AS A6;"
DoCmd.SetWarnings True
Else
Parse = DLookup("Return", sentenceTab, "CodeSentence='" & sentence &
"'")
End If
Exit Function
ParseLanguage:
Debug.Print "Parse error: language='" & language & "'"
End Function
Function NewWord(ByVal language As String, ByVal word As String, _
numLet As Integer, letSum As Integer, letProd As Double) As Integer
'*****************************************************************************
'Word input is checked against the word lists of the language given. If
new,
'its NumLetters and LetterProduct is stored. In each case, numLet,
letSum, and
'letProd (as natural logarithm) are returned. Function value true if
legal
'word found.
'Called from: Parse
'Calls functions:
'Database, module: X_prg.pgm, M_Numerics
'Date, author: 1.7.2001 PR
'*****************************************************************************
Dim i As Integer, letVal As Integer
Dim c As String, crit As String, letterTab As String, wordTab As String
NewWord = False
numLet = 0
letSum = 0
letProd = 0#
word = Trim(word)
If Len(word) < 1 Then Exit Function
NewWord = True
wordTab = language & "Word"
crit = "CodeWord='" & word & "'"
On Error GoTo NewWordLanguage
i = DCount("CodeWord", wordTab, crit)
On Error GoTo 0
If i > 0 Then
numLet = DLookup("NumLetters", wordTab, crit)
letSum = DLookup("LetterSum", wordTab, crit)
letProd = DLookup("LetterProduct", wordTab, crit)
Else
numLet = Len(word)
letterTab = language & "Letter"
For i = 1 To numLet
c = "Code='" & Mid(word, i, 1) & "'"
If DCount("Value", letterTab, c) = 0 Then
NewWord = False
Exit Function
End If
letVal = DLookup("Value", letterTab, c)
letSum = letSum + letVal
letProd = letProd + Log(CDbl(letVal))
Next i
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO " & wordTab & " (CodeWord,NumLetters," _
& "LetterSum,LetterProduct) SELECT '" & word & "' AS A1, " _
& numLet & " AS A2, " & letSum & " AS A3, '" & _
CStr(letProd) & "' AS A4;"
DoCmd.SetWarnings True
End If
Exit Function
NewWordLanguage:
NewWord = False
Debug.Print "NewWord error: language='" & language & "'"
End Function
Function Deviation(ByVal lang As String, ByVal sent As String, _
ByVal con As String, ByVal ret As Double) As Single
'*****************************************************************************
'Deviation of the formula return value ret of the sentence sent in
language
'lang from value c of constant con. The values of ret and c are
normalized to
'between 0 and 1 by ignoring factors of 10. Then the relative deviation
'(r-c)/c is returned, and a result record stored in table Evaluation.
'Called from: Parse
'Calls functions:
'Database, module: X_prg.pgm, M_Numerics
'Date, author: 13.7.2001 PR
'*****************************************************************************
Dim c As Double, r As Double
c = DLookup("ConstValue", "Constant", "ConstName='" & con & "'")
c = Log(c) / Log(10#) 'log10(c) = ln(c) /
ln(10)
Do While c > 1#
c = c - 1#
Loop
Do While c < 0#
c = c + 1#
Loop
c = 10# ^ c
r = Log(ret) / Log(10#)
Do While r > 1#
r = r - 1#
Loop
Do While r < 0#
r = r + 1#
Loop
r = 10# ^ r
Deviation = CSng((r - c) / c)
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO Evaluation (Language,Sentence,ConstName," _
& "Return,Deviation) SELECT '" & lang & "' AS A1, '" _
& sent & "' AS A2, '" & con & "' AS A3, '" & _
CStr(r) & "' AS A4, '" & CStr(Deviation) & "' AS A5;"
DoCmd.SetWarnings True
End Function
Value Letter Code (GreekLetter.-)
1 alpha A
2 beta B
3 gamma G
4 delta D
5 epsilon E
6 endsigma V
7 zeta Z
8 eta H
9 theta U
10 jota J
20 kappa K
30 lambda L
40 my M
50 ny N
60 xi X
70 omikron O
80 pi P
100 rho R
200 sigma S
300 tau T
400 ypsilon Y
500 phi F
600 chi Q
700 psi C
800 omega W
Value Letter Code (HebrewLetter.-)
1 aleph A
2 beth B
3 gimel G
4 daleth D
5 he E
6 waw W
7 zajin Z
8 cheth H
9 theth U
10 joth J
20 kaf K
30 lameth L
40 mem M
50 nun N
60 samech X
70 ajin O
80 pe P
90 tsade Y
100 qof Q
200 resch R
300 sin S
400 taw T
CodeSentence (GreekSentence.-) NumLetters NumWords LetterProduct
WordProduct Return
EN ARQH HN O LOGOS KAJ O LOGOS HN PROS TON UEON KAJ UEOS HN O LOGOS
51 17 172,523835 82,82702947 2,70364E+39
EN ARQH HN O LOGOV KAJ O LOGOV HN PROV TON UEON KAJ UEOV HN O LOGOV
51 17 154,9910455 78,91121692 3,29739E+33
EN ARQHJ HN O LOGOS KAJ O LOGOS HN PROS TON UEON KAJ UEOS HN O LOGOS
52 17 174,82642 82,8410353 2,71831E+40
EN ARQHJ HN O LOGOV KAJ O LOGOV HN PROV TON UEON KAJ UEOV HN O LOGOV
52 17 157,2936306 78,92522275 3,31529E+34
CodeSentence (HebrewSentence.-) NumLetters NumWords LetterProduct
WordProduct Return
BRASJT BRA ALEJM AT ESMJM WAT EARY 28 7 79,15867895 40,25630899
3,14155E+17
CodeWord NumLetters LetterSum LetterProduct (GreekWord.-)
EN 2 55 5,521460918
ARQH 4 709 13,08154138
HN 2 58 5,991464547
O 1 70 4,248495242
LOGOS 5 373 18,29511752
KAJ 3 31 5,298317367
PROS 4 450 18,53400943
TON 3 420 13,86430072
UEON 4 134 11,96718074
UEOS 4 284 13,3534751
LOGOV 5 179 14,78855962
PROV 4 256 15,02745153
UEOV 4 90 9,846917201
ARQHJ 5 719 15,38412648
CodeWord NumLetters LetterSum LetterProduct (HebrewWord.-)
BRASJT 6 913 19,98929666
BRA 3 203 5,991464547
ALEJM 5 86 11,00209984
AT 2 401 5,991464547
ESMJM 5 395 16,99356439
WAT 3 407 7,783224016
EARY 4 296 11,40756495
ConstName ConstValue (Constant.-)
Pi 3,141592654
e 2,718281828
Language Sentence (Evaluation.-) ConstName Return Deviation
Greek EN ARQH HN O LOGOS KAJ O LOGOS HN PROS TON UEON KAJ UEOS HN O
LOGOS e 2,703640352 -0,005386298
Greek EN ARQH HN O LOGOV KAJ O LOGOV HN PROV TON UEON KAJ UEOV HN O
LOGOV e 3,297394999 0,213043794
Greek EN ARQHJ HN O LOGOS KAJ O LOGOS HN PROS TON UEON KAJ UEOS HN O
LOGOS e 2,718312812 1,13983E-05
Greek EN ARQHJ HN O LOGOV KAJ O LOGOV HN PROV TON UEON KAJ UEOV HN O
LOGOV e 3,315289722 0,219626904
Hebrew BRASJT BRA ALEJM AT ESMJM WAT EARY Pi 3,141554508
-1,21422E-05
Regards,
Peter Ruest
-- -------------------------------------------------------------- Dr Peter Ruest Biochemistry Wagerten Creation and evolution CH-3148 Lanzenhaeusern Tel.: ++41 31 731 1055 Switzerland E-mail: <pruest@dplanet.ch - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - In biology - there's no free lunch - and no information without an adequate source. In Christ - there is free and limitless grace - for those of a contrite heart. --------------------------------------------------------------
This archive was generated by hypermail 2b29 : Sat Jul 14 2001 - 15:36:43 EDT