unieke waarden

[SUVERMO]

Sorry,
ik zie juist uw bericht, zal er morgen naar kijken.
Vandaag gaan de dag gewerkt aan het bestand dat ik juist heb geplaatst.


krijg volgende melding
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

 

[cow18]

Google zegt dit hierover

#If VBA7 And Win64 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

ik denk, na 2e poging, dat het toch soms iets te snel gaat voor die site, dus dat de sleeps iets langer zouden moeten zijn ofwel om helemaal zeker te zijn dat je voor het plakken van je stamboom even die "Clear Pedigree>Clear" knoppen zou moeten bedienen en voor "onbekend", als je die tegenkomt, dan moet die vervangen worden door ""

 

[SUVERMO]

Beste alphamax en cow18

cow18 , mocht uw code hier komen?

Public sJSON As String
#If VBA7 And Win64 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Private Sub CommandButton1_Click()

    Dim rRange As Range

    With Range("A1").CurrentRegion
        Set rRange = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
    End With

    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .Navigate "http://www.nabssar.org/coi_calculator/index.html"
        Do
            DoEvents
        Loop While .Busy And .ReadyState <> 4
        Sleep 200

        For Each oRow In rRange.Rows
            oRow.Cells(4) = "Error"

            sChild = oRow.Cells(1)
            sJSON = "{" & vbCrLf
            SireDamJSON rRange, sChild
            sJSON = Mid(sJSON, 1, Len(sJSON) - 3)

            With .Document
                .getElementById("textarea").Value = sJSON
                Sleep 200

                Set mouseDownEvent = .createEvent("MouseEvent")
                mouseDownEvent.initEvent "mousedown", True, False
                .getElementById("populate").dispatchEvent mouseDownEvent
                Sleep 200
                .getElementById("calculate").dispatchEvent mouseDownEvent
                Sleep 400

                oRow.Cells(4) = Split(.getElementById("result").innertext, "=")(1)
                Sleep 200
            End With
        Next
        .Quit
    End With
End Sub

Private Sub SireDamJSON(rRange As Range, ByVal sChild As String)    'am_2022
    lChildRow = Application.Match(sChild, rRange.Columns(1), 0)
    If Not IsError(lChildRow) Then
        sChildSire = rRange.Rows(lChildRow).Cells(2)
        sJSON = sJSON & Chr(34) & "s" & Chr(34) & ": {" & vbCrLf
        SireDamJSON rRange, sChildSire
        sChildDam = rRange.Rows(lChildRow).Cells(3)
        sJSON = sJSON & Chr(34) & "d" & Chr(34) & ": {" & vbCrLf
        SireDamJSON rRange, sChildDam
    End If
    sJSON = sJSON & Chr(34) & "name" & Chr(34) & ": " & Chr(34) & sChild & Chr(34) & vbCrLf
    sJSON = sJSON & " }," & vbCrLf
End Sub

alphamax het is ongelooflijk hoe snel, bij mij 1,2 second per item.
ik ga het verder testen

hebben jullie gekeken naar
https://www.helpmij.nl/forum/showthread.php/965699-Ctrl-V-en-Ctrl-C-op-website
volgens mij zal het nooit zo snel kunnen gaan, nu wel geen detail van de inteelt, mogelijk gaat dat wel lukken bij het volgende.
als men dubbel klikt op een inteelt %, dan een andere module laten starten die het resultaat opnieuw over het vorige resultaat wegschrijft in een andere tabblad en dit blad dan zichtbaar maken


voor beide heel erg bedankt

 

[alphamax]

waw, en ik die dacht dat internet explorer niet meer mocht, wegens niet meer ondersteunt ???

Alleen internet explorer werkt samen met VBA.
Je loopt dus inderdaad een bepaald risico.
Ik moet eens kijken wat mogelijk is met de "IE Mode" van edge.
Of "WebDriver" voor edge.
Selenium, Puppeteer and Playwright zijn libraries met andere programmeertalen om de andere browsers te automatiseren, hier zijn ook mogelijkheden.

Het werkt wel netjes en razend snel.

Mag altijd wat langzamer dus betrouwbaarder, is altijd sneller dan met de hand knippen en plakken

1e opmerking, indien een voorouder "onbekend" is, dan geef je die niet mee of voeg je er een indexnummer aan toe, Onbekend1, Onbekend2, etc. Anders gaat die site er van uit dat het dezelfde gemeenschappelijke voorouder is en wordt er voor die "onbekende" een percentage inteelt toegekend.

Het is aan suvermo om dat mee te nemen in zijn gegevens

 2e opmerking, ik kan zo snel niet meelezen, maar ik dacht soms hetzelfde dier zowel als vader en als moeder staan, dat zou wel straf zijn, dus dat zal wel ergens onderweg fout opgegeven zijn.

KLOON is zowel vader als moeder, het is aan suvermo om dat mee te nemen in zijn gegevens

Maar anders netjes ...
Zou het moeilijk zijn om uit je ("result").innertext vanaf een F>3% het aandeel van de strafste voorouder mee te geven, dus de 1e lijn onder die F (in het scherm hierboven 0.24% van Bold Ruler)

is mogelijk, wacht op de update

 

[cow18]

:thumb::thumb::thumb:

 

[alphamax]

Nieuwe code.

 

[cow18]

knap, ...
Misschien heb ik een beetje geknoeid en kan het netter, maar TS wilde ook een individueel dier zien (in een nieuwe topic).
Misschien zo, dus kies een dier in H5 (=individu) of laat die leeg (=loop)

 

[SUVERMO]

Bedankt voor het meedenken

Hierbij het bestand waarin ik het wens te gebruiken, dat had ik beter vroeger gedaan.

bestaande macro's heb ik verwijderd
tabladen die voor dit nodig zijn heb ik verwijderd
kolommen en rijen die voor dit nodig zijn heb ik leeggemaakt
formules zijn ook verwijderd behalve die juist zijn toegevoegd in P en Q
kolom P en Q gebruiken voor F = %
Verdere vragen staan in bladen Dieren_Bib en Nesten

hopelijk is nu duidelijk wat de bedoeling is.

 

[SUVERMO]

Verdere vragen staan in bladen Dieren_Bib en Nesten

na een nachtje slapen ga ik dit wijzigen in
Verdere vragen staan in bladen Dieren_Bib en Nesten en Stamboom
bestand zal straks volgen

 

[SUVERMO]

Voor als het eerste kind op rij 11 staat heb ik de code kunnen aanpassen

Wat moet er in de code aangepast worden voor.
Kinderen in kolom C
Vaders in kolom O
Moeders in kolom P
Het resultaat F in kolom Q

Dit is ongeveer hetzelfde vraag als in #69

 

[cow18]

zoiets dan ?

 

[snb]

@cow18

Kun je mij informeren ?

Waar gaat het om in deze casus ?

- de vergelijking van 2 dieren
- de vergelijking gaat over de mate van verwantschap
- daarbij wordt zowel in de vaderlijn als de moederlijn gekeken naar een gemeenschappelijke voorouder
- de kortste lijn naar een voorouder bepaalt de mate van verwantschap
- voor de mate van verwantschap wordt blijkbaar de 'F-score' gebruikt.
- kun je mij vertellen hoe de berekening van de F-score in zijn werk gaat ?
- klopt het dat iedere generatie bij de naamgeving een eigen generatie-aanduiding krijgt ?

Waarom vraaag ik dit ?

Het lijkt mij tamelijk eenvoudig de verwantschapscore te berekenen op basis van een Array/Dictionary (= een Array met sleutels) bestaande uit per dier een naamopsomming van alle nakomelingen.
Op basis darvan kan een Array/Dictionary geproduceerd worden van alle voorouders per dier.
De vergelijking van 2 dieren is dan een vergelijking van de voorouderitems in de 2 Array-items van die 2 dieren.
Wat mij ontbreekt is de formule voor de berekening van de 'F-score'.

 

[cow18]

Heel ver in mijn grijze massa terug delvend, je gaat van ieder dier in je database de stamboom terug samenstellen, dat is wat Alphamax zo netjes doet in die "SireDamJSON"-macro, vertrekkend van een database met ieder dier + vader + moeder. Daar komt een "Tree" uit, die gekopieerd wordt in dat linker vak van die site en die wordt dan intern verder gekopieerd tot die stamboom rechts.
Dan ga je met je kleurenstift stuk per stuk een gemeenschappelijke stamouders gaan merken in de vaderlijn en de moederlijn. Die kan dus vaker voorkomen in elk van die 2 takken. Dan moet je grafen gaan maken, dat zijn alle mogelijke manieren dat je van je dier naar boven gaande via de moederlijn tot die gemeenschappelijke voorouder, dan jumpen naar diezelfde voorouder in de vaderlijn en terug naar beneden. Dan tel je het aantal lijnstukjes dat je daarvoor nodig had, als graad van verwantschap = 1/macht(2;aantal lijnstukken-x(?)). Als die voorouder dan ook nog eens het resultaat was van inteelt, dan krijgt die ook nog een keer een hoger gewicht mee, etc, etc. Dus eigenlijk moet je een soort recurrente berekening maken en dan helemaal op het einde moet je die boel samentellen moet je als het ware van iedere dier (=knooppunt) zijn inteeltcoefficient gaan rekenen.
Stel afstammeling van een broer en een zuster : je start bij het dier, gaat via de vader (= broer) naar de grootvader, jump naar de moederlijn diezelfde grootvader en zak je via de moeder (=zuster) terug bij het dier. Dat doe je ook nog een keer voor de gemeenschappelijke grootmoeder, etc, etc.
Het is een heel minitieus werkje waarbij je gemakkelijk een pad overslaat of het gewicht van een voorouder verkeerd meeneemt. EN IK HEB EEN HEKEL AAN DIT SINDS IK DAARVOOR EEN HEREXAMEN MOEST DOEN, 40 jaar geleden. Dus gelukkig bestaan daar vandaag apps voor.

een beetje schemas https://www.wired.com/2012/01/the-inbreeding-of-superheroes/
https://www.youtube.com/watch?v=DvTsqD0v25s (en ook 3 andere videos)
maar begin hier niet aan als je geen grijze haren wilt krijgen.

even de moeilijkste van die reeks nemen met stamboom en berekening van F, de macro van Alphamax zal nu niet in een loop gaan, maar direkt het meest ingeteelde dier pakken en dan stoppen met internet explorer nog open, zodat je daar die stamboom kan zien, die ik nu ook als GIF in bijlage gestopt heb

De vader 0NZ-503 is ook grootvader aan moeders zijde wat normaal F=25% is, maar aangezien die ook niet helemaal inteeltvrij is, moet daar nog één en ander bijgeteld worden en komt je zo op die +31%.
Dan heb je de grootmoeder aan vader's zijde 7NZ-801 die ook nog zijn zegje doet voor +14% etc

Ik denk dat je best start met bij ieder ieder op de stamboom zijn eigen F-waarde te gaan zetten zoals de site je voorgerekend heeft.
Dan start je bij de oudste generatie en zak je langzaam naar beneden (= naar links) en kijk je of je je berekening sluitend krijgt.
Voor dit dier zou je dus 11 kopieën van je stamboom moeten maken ofwel 11 kleurstiften, want in totaal zou je vermoedelijk 11 verschillende lussen of paden kunnen maken via gemeenschappelijke voorouders.
Vraag me aub niets meer van uitleg, mijn maag draait, 40 jaar na datum, nog van dit soort berekeningen. Ik had het toen niet goed begrepen en er nooit meer naar om gekeken.