As you may recall from the original
Inherited Veracity puzzle, the land of Kivel is inhabited by 4 types of people:
- Knight: (produced by KK homozygous and KO heterozygous genotypes),
- Liar: (produced by LL homozygous and LO heterozygous genotypes),
- Knave: (produced by the KL heterozygous genotype), and
- Transposer: (produced by the OO homozygous genotype).
Knights always tell the truth, liars always lie, knaves' statements strictly alternate between truth and lie, and a transposer's statements are always of opposite truth-value to the person who spoke immediately before. (If a transposer is the first to make a statement, he or she will randomly choose between telling the truth or lying for their first statement.
Given the following statements from Zander, Yvette, Xerxes, and Willow, can you determine the genotype of each Kivelian, as well who is related to whom?
Willow: Exactly three of us are homozygous.
Zander: I have an L allele.
Xerxes: I am homozygous.
Yvette: I am a knight.
Zander: I am a knight.
Yvette: One of us is not directly related to the other three.
Willow: I am heterozygous.
Xerxes: I am a transposer.
Yvette: Two of us share the same genotype, and I'm not one of them.
Xerxes: I have a K allele.
Zander: I am homozygous.
Willow: Yvette is heterozygous.
Xerxes: Willow is heterozygous.
Willow: Xerxes is heterozygous.
Yvette: Between the four of us, we have exactly two K alleles.
Zander: At least one of us is a knave.
Note: The spacing used is only for readability; you may assume all statements were said consecutively in the order shown.
DefDbl A-Z
Dim crlf$, indtype(6) As String, wtype As String, xtype As String, ytype As String, ztype As String
Dim wgeno As String, xgeno As String, ygeno As String, zgeno As String
Function mform$(x, t$)
a$ = Format$(x, t$)
If Len(a$) < Len(t$) Then a$ = Space$(Len(t$) - Len(a$)) & a$
mform$ = a$
End Function
Private Sub Form_Load()
ChDir "C:Program Files (x86)DevStudioVBprojectsflooble"
Text1.Text = ""
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
DoEvents
indtype(1) = "kk"
indtype(2) = "ko"
indtype(3) = "ll"
indtype(4) = "lo"
indtype(5) = "kl"
indtype(6) = "oo"
For w = 1 To 6
wgeno = indtype(w)
wtype = eval(indtype(w))
wtrue = tval(wtype)
For x = 1 To 6
xgeno = indtype(x)
xtype = eval(indtype(x))
xtrue = tval(xtype)
For y = 1 To 6
ygeno = indtype(y)
ytype = eval(indtype(y))
ytrue = tval(ytype)
For z = 1 To 6
zgeno = indtype(z)
ztype = eval(indtype(z))
ztrue = tval(ztype)
kvct = Abs((wtype = "kv") + (xtype = "kv") + (ytype = "kv") + (ztype = "kv"))
Select Case kvct
Case 0
cyclim = 0
Case 1
cyclim = 1
Case 2
cyclim = 3
Case 3
cyclim = 7
Case 4
cyclim = 15
End Select
For cycl = 0 To cyclim
c = cycl
If wtype = "kv" Then
wtrue = c Mod 2: c = c 2
End If
If xtype = "kv" Then
xtrue = c Mod 2: c = c 2
End If
If ytype = "kv" Then
ytrue = c Mod 2: c = c 2
End If
If ztype = "kv" Then
ztrue = c Mod 2: c = c 2
End If
Next
good = 1
hzct = Abs((Left(wgeno, 1) = Right(wgeno, 1)) + (Left(indtype(x), 1) = Right(indtype(x), 1)) + (Left(indtype(y), 1) = Right(indtype(y), 1)) + (Left(indtype(z), 1) = Right(indtype(z), 1)))
t = wtrue
If Abs(hzct = 3) <> t And t <> -1 Then good = 0: GoTo notthis
t = Abs(hzct = 3): h$ = LTrim(Str(t))
If ztrue >= 0 Then t = ztrue Else t = 1 - t
If Abs(InStr(zgeno, "l") > 0) <> t Then good = 0: GoTo notthis
t = Abs(InStr(zgeno, "l") > 0): h$ = h$ + LTrim(Str(t))
If xtrue >= 0 Then t = xtrue Else t = 1 - t
If Abs(Left(xgeno, 1) = Right(xgeno, 1)) <> t Then good = 0: GoTo notthis
t = Abs(Left(xgeno, 1) = Right(xgeno, 1)): h$ = h$ + LTrim(Str(t))
If ytrue >= 0 Then t = ytrue Else t = 1 - t
If Abs(ytype = "kt") <> t Then good = 0: GoTo notthis
t = Abs(ytype = "kt"): h$ = h$ + LTrim(Str(t))
If ztrue >= 0 Then t = ztrue Else t = 1 - t
If Abs(ztype = "kt") <> t Then good = 0: GoTo notthis
t = Abs(ztype = "kt"): h$ = h$ + LTrim(Str(t))
If ytrue >= 0 Then t = ytrue Else t = 1 - t
If unrelated(w, x) And unrelated(w, y) And unrelated(w, z) Then unrelct = 1 Else unrelct = 0
If unrelated(x, w) And unrelated(x, y) And unrelated(x, z) Then unrelct = unrelct + 1
If unrelated(y, w) And unrelated(y, x) And unrelated(y, z) Then unrelct = unrelct + 1
If unrelated(z, w) And unrelated(z, x) And unrelated(z, y) Then unrelct = unrelct + 1
If Abs(unrelct = 1) <> t Then good = 9: GoTo notthis
t = Abs(unrelct = 1): h$ = h$ + LTrim(Str(t))
If wtrue >= 0 Then t = wtrue Else t = 1 - t
If Abs(Left(wgeno, 1) <> Right(wgeno, 1)) <> t Then good = 0: GoTo notthis
t = Abs(Left(wgeno, 1) <> Right(wgeno, 1)): h$ = h$ + LTrim(Str(t))
If xtrue >= 0 Then t = xtrue Else t = 1 - t
If Abs(xtype = "t") <> t Then good = 0: GoTo notthis
t = Abs(xtype = "t"): h$ = h$ + LTrim(Str(t))
If good Then
Text1.Text = Text1.Text & indtype(w) & " " & indtype(x) & " " & indtype(y) & " " & indtype(z) & crlf
Text1.Text = Text1.Text & h$ & crlf & crlf
End If
notthis:
Next
Next
Next
Next
Text1.Text = Text1.Text & crlf & " done"
End Sub
Function eval$(n$)
Select Case n$
Case "kk", "ko"
eval = "kt"
Case "ll", "lo"
eval = "l"
Case "kl"
eval = "kv"
Case "oo"
eval = "t"
End Select
End Function
Function tval(x$)
Select Case x$
Case "kt"
tval = 1
Case "l"
tval = 0
Case "kv"
tval = -1
Case "t"
tval = -1
End Select
End Function
Function unrelated(a, b)
s1$ = indtype(a): s2$ = indtype(b)
If InStr(s1$, Left(s2$, 1)) > 0 Or InStr(s1$, Right(s2$, 1)) > 0 Then
unrelated = 0
Else
unrelated = 1
End If
End Function
tests only the first 8 of the 16 statements and already finds the solution:
oo lo kk oo
10010100
Annotated, this is:
Genotypes of W, X, Y and Z: oo lo kk oo
Phenotypes of W, X, Y and Z: T L Kt T (Transposer, Liar, Knight, Transposer)
First 8 statements speakers: wzxyzywx
First 8 statements truth value: 10010100
Phenotypes for first 8 statements: TTLKTKTL
The remaining 8 statements check out with a manual check as consistent with this answer.
|
|
Posted by Charlie
on 2014-09-12 13:24:44 |
computer solution
