Element uit Array verwijderen

Status
Niet open voor verdere reacties.
Ben er uit, ik laat er Oplosser (Solver) op los, zodat er meerdere elementen tussen kolommen gewisseld kunnen worden.
Heb je die al geactiveerd of ben je van plan dat te doen ? Dan kan ik verder experimenteren.
Zo te zien heb je nog een oudere versie, zodat ik niet precies kan aangeven wat je moet doen.
- eerst in Bestand>Opties>Invoegtoepassingen moet je daar die Oplosser (of Solver in het engels) activeren
- daarna in het VBA-scherm onder Extra>Verwijzingen moet je daar ook de Solver aanvinken.

Valt dat binnen de mogelijkheden ?
 
Dag Cow18,

Die Solver heb ik getest ja, maar doorstaat de test niet bij elke situatie... tenzij ik deze niet goed gebruik.
Sover werkt in Excel... ook voor hem/haar stijgt echter de rekentijd exponentieel met het aantal getallen...
Test maar eens op die laatste test met 100 getallen waar ik manueel goed resultaat behaalde. Denk nooit dat die beter zal doen maar je laat mij nu twijfelen, gij kunt toveren met Excel... :shocked:
Probleem is iets te vinden dat in elke situatie goed resultaat geeft en zonder brute kracht door alle combinaties te maken schijnt dat weinig te lukken.
Raar dat jij voor 100 getallen 0.023 sec kunt scoren... het was niet zuiver maar ik doe het zeker niet na.

Als nerd gebruik ik Office 2019 64bit, hehe maar sla die voor het forum op als .xls zodat meer mensen bestand kunnen lezen.
Ja als die mijn record van 100 kan breken valt die zeker binnen mijn mogelijkheden en welkom :)

Groetjes en bedankt nog!
Leika
 
even een voorlopige versie, zie macro "testen".
Die zet die tabel van 10*10 klaar volgens methode 2. (kolommen T:AC)
Hij zal daarna met solver telkens 2 kolommen tov. elkaar zetten en elementen uitwisselen. (kolommen AG:AP en AU:AV)
Dat doet hij tot er niets meer gedaan kan worden.
Solver krijgt telkens 1 minuut om tot een oplossing te komen. Is die tijd afgelopen, dan krijg je een scherm "doorgaan of stoppen".
Klik dan op stoppen (of doorgaan als je veel tijd hebt) en dan worden die 2 kolommen in behandeling volgens het tussenresultaat gewisseld.
Zo krijg ik nu op minder dan 3 minuten een resultaat, die volgens mij, niet verbeterd kan worden. Ik kan moeilijk achter de komma beginnen uitwisselen met integers :(

Bon, dit was een beta-versie, dus layout en zo zijn voor verbetering vatbaar en er zit nog andere rommel in.

Eigenlijk zit ik me zelfs af te vragen, moesten die 100 getallen nu gewoon willekeurig in die 10*10-tabel gestopt worden en daarna de solver zijn werk laten doen, wat dat voor extra tijd zou vragen, een nerdvraag.
In de solver, bij de opties, kan je ook je max. tijd instellen. Die had ik op 60 sec staan, met 30 sec werkt het ook. Dan doe ik het in totaal 90 sec. Anders nog even het optimum zoeken.
Blijkbaar wordt er in de laatste 30 sec geen betere oplossing gevonden.
 

Bijlagen

  • Forum3.xls
    152,5 KB · Weergaven: 18
Laatst bewerkt:
verbeterde versie.
Nu werkt hij telkens met andere 100 getallen.
Soms gaat hij in de fout en kreeg hij niet al die getallen in de tabel, daar moet ik nog even naar kijken, even tot daar.
Eens in de tabel, wordt de solver 5-10 keer aangeroepen.
Klaar in 30-60 sec.
In kolommen BA:BC staan wat tussentijden
 

Bijlagen

  • Forum4.xls
    161,5 KB · Weergaven: 18
Dag Cow18

Ik behaalde een gemiddelde van 5.100 in 59 sec
Het gaat de goede kant op, niet?

Groetjes,
Leika
 
jij tevreden, ik tevreden !!!
In #23 had ik gesteld dat gewoon willekeurig die 100 geztallen in een 10*10 stoppen en daarna solver zijn werk laten doen, wat dat zou geven.
Voorlopig gaat dat nog niet de goeie kant uit.
Hij stopt te vroeg, daarom zat ik te kijken om de selectie van de kolommen nog uit te breiden ofwel de doelfunctie van de solver aan te passen, geen som van de absolute afwijkingen, maar bijvoorbeeld de som van de kwadraten van de afwijkingen.
Voorlopig nog zonder resultaat.

Had je al naar de macros zelf gekeken ?
Zijn er zaken die je niet begrijpt ?
 
Suggestie:

Code:
Sub Aanmaak()
    Randomize
    Dim sn(1 To 100, 0) As Integer                                     'maak een array, 100 elementen, vul die met willekeurige integers tss 100 en 900

    For i = 1 To UBound(sn)
        sn(i, 0) = 100 + Rnd * 900
    Next

    With Blad2
        .cells(11,5).Resize(10, 40).ClearContents                  'uitvoer wissen
        .Cells(1).Resize(100) = sn                                                  'getallen wegschrijven
        If dStart > 0 Then .Range("BA" & Rows.Count).End(xlUp).Offset(1).Resize(, 3) = Array(iTest, Microtimer - dStart, "Einde Aanmaak")
    End With
End Sub
 
ach ja, inderdaad, die randomize en die array, slim.
 
Dag Cow18,

Nee, de code begrijp ik steeds niet daar heb ik veel tijd voor nodig.:confused:
Maar kan je die eens laten werken op mijn cijfers want bij mij lukt het niet, schakel ik de random uit dan moet ik 5 tot 10 min wachten.

Veel dank voor je harde werk!

Groetjes Leika

 

Bijlagen

  • Forum4.xls
    99,5 KB · Weergaven: 14
Laatst bewerkt door een moderator:
ik was al een klein beetje verder, dus heb ik enkel kolom A naar mijn laatste versie overgehaald.
Inderdaad, daar bijt hij ook zijn tanden op stuk.
Blijkbaar een moeilijke combinatie van cijfers.

In de code zelf, daar staan een aantal parameters waar ik even mee aan het stoeien gegaan ben.
Vraag me niet achter de logica, maar met deze instellingen lukt het op 30 sec.
De link met uitleg staat erbij, van mij mag je er eventjes ook mee stoeien, soms lijkt hij er zich niets van aan te trekken ...
Code:
SolverOptions maxtime:=10, Precision:=0.00125 ', , iterations:=100, maxsubproblems:=100

Voor zware gevallen gebruik ik GAMS ipv. Solver, maar dat vraagt wat ombouwwerk.
Is dat het waard ?
 

Bijlagen

  • Forum6.xls
    161 KB · Weergaven: 17
Dag Cow18,

Alles eens goed getest!
Werkt perfect bij kleine getallen maar niet snel bij grote getallen zoals 4500.
Na een klein 10 tot 15 min haal ik de uitslag binnen, echt jammer.

Vandaag deze link ontvangen; zo een beetje wat ik wil maar de code is in Javascript en maakt gebruik van functies in Underscore.
Je kan deze testen en in 1 sec is de uitslag binnen, hoe komt dat toch?
https://jsfiddle.net/vbqna7vc/18/

Alvast heel erg bedankt voor de geleverde inspanningen...

Groetjes,
Leika


Code:
/*
The MIT License (MIT)
Copyright (c) 2016 Dex Wood

Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
*/
var optimizeBtn = document.getElementById("optimizeBtn");
var cellsPerPackInput = document.getElementById('cellsPerPack');
var cellsInput = document.getElementById("cells");
/* TEKST */

optimizeBtn.onclick = function () {
	var cellsPerPack = parseInt(cellsPerPackInput.value);   									
	console.log("*** cellsPerPack " + cellsPerPack);
	var cells = _.map(cellsInput.value.split(","), function (c) {return parseInt(c);});   /* Bij mij CellsRng */
	console.log("*** cells " + cells);
	var numPacks = cells.length / cellsPerPack;
	console.log("*** numPacks " + numPacks);
	var averageDiv = parseInt(sum(cells) / numPacks);
	console.log("*** averageDiv " + averageDiv);
	
	var solution = simulatedAnnealingBatteries(cells, cellsPerPack, averageDiv);
	console.log("*** solution " + solution);
	
	var optimizedCellsInput = document.getElementById("optimizedCells");
	var solutionPacks = multiPartition(solution, cellsPerPack);
	var solutionOutput = "";
	console.log(solution);
	console.log("Cost: " + cost(solution, numPacks, averageDiv));
	solutionOutput += "Optimized Packs\n\n";
	solutionOutput += "Pack average: " + parseInt(averageDiv) + "\n";
	for (var idx in solutionPacks) {
		var packNum = parseInt(idx) + 1;
		solutionOutput += "Pack " + packNum + "\n";
		solutionOutput += JSON.stringify(_.sortBy(solutionPacks[idx], function (d) {
			return -d;
		})) + "\n";
		console.log("Sum: " + sum(solutionPacks[idx]));
		solutionOutput += "Difference from average: " + parseInt(sum(solutionPacks[idx]) - averageDiv) + "\n\n";
	}
	optimizedCellsInput.value = solutionOutput;
}

function multiPartition(cells, n) {
	var partitions = [];
	var packs = (cells.length / n);
	for (var i = 0; i < packs; i++) {
		partitions.push([]);
	}
	for (var idx in cells) {
		partitions[idx % packs].push(cells[idx]);
	}
	return _.filter(partitions, function (p) {
		return p.length > 0;
	})
}

function cost(solution, numPacks, averageDiv) {
	var packDivision = multiPartition(solution.slice(), numPacks);
	var totalCost = _.map(packDivision, function (p) {
		return Math.abs(sum(p) - averageDiv);
	});
	return sum(totalCost);
}

function acceptanceProb(curCost, cost, temperature) {
	return Math.pow(Math.E, (curCost - cost) / temperature);
}

function sum(items) {
	return _.reduce(items, function (a, b) {
		return a + b;
	});
}

function simulatedAnnealingBatteries(cells, numPacks, avgDiv) {

	var currentSolution = cells.slice();									 /* De cells in array steken */
	console.log("*** currentSolution " + currentSolution);
	var curCost = Number.MAX_VALUE;
	console.log("*** curCost " + curCost);
	var minTemperature = 1e-6;
    console.log("*** minTemperature " + minTemperature);
	var temperature = 1.0;
	var cooling = 0.93;
	while (temperature > minTemperature) {
		for (var i = 0; i < 100; i++) {
			var neighboringSolution = currentSolution.slice();
			//console.log("*** neighboringSolution " + neighboringSolution);
			var first = parseInt(Math.random() * cells.length);
			//console.log("*** ("+ i +") first " + first);
			var second = parseInt(Math.random() * cells.length);
			//console.log("*** ("+ i +") second " + second);
			var tmp = neighboringSolution[first];
			//console.log("*** ("+ i +") tmp " + tmp);
			neighboringSolution[first] = neighboringSolution[second];
			neighboringSolution[second] = tmp;
			var newCost = cost(neighboringSolution, numPacks, avgDiv);
			var prob = acceptanceProb(curCost, newCost, temperature);
			if (prob > Math.random()) {
				currentSolution = neighboringSolution;
				curCost = newCost;
			}
		}
		temperature *= cooling;  // x = x * y
		//console.log("*** ("+ i +") temperature " + temperature);
	}
	//console.log("*** loop i = " + i);
	
	return currentSolution;
}
 
Laatst bewerkt:
ik begrijp geen java, probeer het straks eens te ontcijferen, maar vermoedelijk wordt dat hopeloos.
Bon, eerst klaagde je en had je het over uren en dagen, daarna had ik dat gereduceerd tot minuten en nu tot binnen de minuut (kleine getallen).
Nu word ik geklopt door iets op 1 seconde :confused:
Tja, het is niet anders.
 
Kun je svp die javacode hier plaatsen ?
 
Dag Cow18,

Nee, ik klaag niet, zou gewoon niet durven...
Ben zelfs heel blij met je code, steeds 100% beter dan manueel!
Vroeg mij dus wel af waarom Java Excel kan kloppen op gebied van berekeningen...

Nog erg bedankt voor je code!

@snb,
Zal de code straks hier plaatsen

Groetjes allebei,
Leika
 
ik kan die java niet doorgronden, ergens moeten ze op een geniale manier het aantal combinaties weten te beperken.
Je hebt alvast een oplossing waar je mee kunt werken, dus dat is het belangrijkste.
 
ik heb zo al 68 sec nodig om alle combinaties (4,5 miljard) af te lopen zonder iets te doen :eek:
Code:
Sub testing()
    i = 83
    d = Microtimer
    For i1 = 0 To i - 6
        Application.StatusBar = i1
        For i2 = i1 + 1 To i - 5
            For i3 = i2 + 1 To i - 4
                For i4 = i3 + 1 To i - 3
                    For i5 = i4 + 1 To i - 2
                        For i6 = i5 + 1 To i - 1
                            For i7 = i6 + 1 To i
                            Next
                        Next
                    Next
                Next
            Next
        Next
    Next
    Application.StatusBar = False
    MsgBox Microtimer - d
End Sub
 
Laatst bewerkt:
snb, Redmog stopt ook ergens bij 10, laat staan 84.
ik had een foutje gemaakt in het aantal combinaties
het is niet 84! / (7! * 77!) maar 84! / (72! * 12!) en dan duurt het dagen om alles af te lopen
Als ik geen idee heb van hoe die Java dat benadert, dan houdt het hier op.
 
Ik heb hier nog geen java geplaatst zien worden ?
Dan zouden er meer mensen naar kunnen kijken.
 
#31, maar 't is niet meer zo belangrijk.
Als ik maar gewoon weet hoe ze dat geflikt hebben.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan