Related
I have 2 images, I need to put one on top of the other.
The second image is taken on a pink background (simulated below) and due to the light falloff the background is more sort of a gradient.
I need to place the image on the other one and remove the background color. I would like to define a Hue-range that represents my background, and have every pixel that falls into this range removed/being transparent so that it is pasted on top as if it had a transparent background.
This is the sample image I would like to paste on any random image:
I am able to paste the image onto another image by using this:
' Draw from the source to the destination.
gr.DrawImage(fr_bm, to_rect, fr_rect, GraphicsUnit.Pixel)
(image, destination rectangle, source rectangle)
But I cannot figure out how to remove the background.
Any help is greatly appreciated.
This is a standard Color replacement filter (simplified -> no pre Convolution, since you just want to make transparent all pixels with colors that fall within a range).
It takes a source image, copies it to a 32Bit ARGB bitmap, then generates an identical container, used as destination bitmap.
All colors are compared to the Color specified in the colorFrom argument and, if the Color's components are within a threshold defined by the tolerance argument, the Color is replaced with the Color specified in the colorTo argument.
The tolerance value should be in the range (1:100) (just because Photoshop and other graphic programs do that), the ColorReplacement method normalizes this value on its own.
Possible results:
With the image in your example, with colorFrom set to Color.Fucsia and colorTo set to Color.Transparent, the green region is isolated with a tolerance of ~56, then all remaining traces of the outer Color disappear (along with any anti-aliasing), between 80 and 90. After that, also the green area begins to fade away. Around 95, you have a completely transparent Bitmap.
With a colorFrom set to (255, 226, 18, 212), the same results appear at ~38, then 60 to 70 (the replacement is more subtle).
Which means you have to pick a source color that gives better result, in your view and context.
Try it out passing different values to the method.
C# version:
public Bitmap ColorReplacement(Bitmap image, Color colorFrom, Color colorTo, float tolerance)
{
tolerance = (byte)(255.0f / 100.0f * Math.Max(Math.Min(100.0f, tolerance), 0.1f));
Bitmap source = new(image.Width, image.Height, PixelFormat.Format32bppArgb);
source.SetResolution(image.HorizontalResolution, image.VerticalResolution);
using (var g = Graphics.FromImage(source)) {
g.PixelOffsetMode = PixelOffsetMode.Half;
g.DrawImage(image, Point.Empty);
}
Bitmap destImage = new(source.Width, source.Height, PixelFormat.Format32bppArgb);
destImage.SetResolution(image.HorizontalResolution, image.VerticalResolution);
foreach (PropertyItem item in image.PropertyItems) {
source.SetPropertyItem(item);
destImage.SetPropertyItem(item);
}
var dataFrom = source.LockBits(new Rectangle(0, 0, source.Width, source.Height), ImageLockMode.ReadOnly, PixelFormat.Format32bppArgb);
var dataTo = destImage.LockBits(new Rectangle(0, 0, destImage.Width, destImage.Height), ImageLockMode.WriteOnly, PixelFormat.Format32bppArgb);
byte[] buffer = new byte[Math.Abs(dataTo.Stride) * dataTo.Height];
Marshal.Copy(dataFrom.Scan0, buffer, 0, buffer.Length);
source.UnlockBits(dataFrom);
int bytesPerPixel = Image.GetPixelFormatSize(source.PixelFormat) / 8;
for (int pos = 0; pos < buffer.Length; pos += bytesPerPixel) {
byte blue = buffer[pos];
byte green = buffer[pos + 1];
byte red = buffer[pos + 2];
if ((blue < colorFrom.B + tolerance && blue > colorFrom.B - tolerance) &&
(green < colorFrom.G + tolerance && green > colorFrom.G - tolerance) &&
(red < colorFrom.R + tolerance && red > colorFrom.R - tolerance)) {
int newBlue = colorFrom.B - blue + colorTo.B;
int newGreen = colorFrom.G - green + colorTo.G;
int newRed = colorFrom.R - red + colorTo.R;
buffer[pos] = (byte)Math.Max(Math.Min(255, newBlue), 0);
buffer[pos + 1] = (byte)Math.Max(Math.Min(255, newGreen), 0);
buffer[pos + 2] = (byte)Math.Max(Math.Min(255, newRed), 0);
buffer[pos + 3] = colorTo.A;
}
}
Marshal.Copy(buffer, 0, dataTo.Scan0, buffer.Length);
destImage.UnlockBits(dataTo);
return destImage;
}
VB.NET version:
Public Shared Function ColorReplacement(imageSource As Bitmap, colorFrom As Color, colorTo As Color, tolerance As Single) As Bitmap
tolerance = CByte(255.0F / 100.0F * Math.Max(Math.Min(100.0F, tolerance), 0.1F))
Dim source As New Bitmap(imageSource.Width, imageSource.Height, PixelFormat.Format32bppArgb)
source.SetResolution(imageSource.HorizontalResolution, imageSource.VerticalResolution)
Using g = Graphics.FromImage(source)
g.PixelOffsetMode = PixelOffsetMode.Half
g.DrawImage(imageSource, Point.Empty)
End Using
Dim destImage As Bitmap = New Bitmap(source.Width, source.Height, PixelFormat.Format32bppArgb)
destImage.SetResolution(imageSource.HorizontalResolution, imageSource.VerticalResolution)
For Each item As PropertyItem In imageSource.PropertyItems
source.SetPropertyItem(item)
destImage.SetPropertyItem(item)
Next
Dim dataFrom = source.LockBits(New Rectangle(0, 0, source.Width, source.Height), ImageLockMode.ReadOnly, PixelFormat.Format32bppArgb)
Dim dataTo = destImage.LockBits(New Rectangle(0, 0, destImage.Width, destImage.Height), ImageLockMode.WriteOnly, PixelFormat.Format32bppArgb)
Dim buffer As Byte() = New Byte(Math.Abs(dataFrom.Stride) * dataFrom.Height - 1) {}
Marshal.Copy(dataFrom.Scan0, buffer, 0, buffer.Length)
source.UnlockBits(dataFrom)
Dim bytesPerPixel As Integer = Image.GetPixelFormatSize(source.PixelFormat) \ 8
For pos As Integer = 0 To buffer.Length - 1 Step bytesPerPixel
Dim blue As Integer = buffer(pos)
Dim green As Integer = buffer(pos + 1)
Dim red As Integer = buffer(pos + 2)
If (blue < colorFrom.B + tolerance AndAlso blue > colorFrom.B - tolerance) AndAlso
(green < colorFrom.G + tolerance AndAlso green > colorFrom.G - tolerance) AndAlso
(red < colorFrom.R + tolerance AndAlso red > colorFrom.R - tolerance) Then
Dim newBlue As Integer = colorFrom.B - blue + colorTo.B
Dim newGreen As Integer = colorFrom.G - green + colorTo.G
Dim newRed As Integer = colorFrom.R - red + colorTo.R
buffer(pos) = CByte(Math.Max(Math.Min(255, newBlue), 0))
buffer(pos + 1) = CByte(Math.Max(Math.Min(255, newGreen), 0))
buffer(pos + 2) = CByte(Math.Max(Math.Min(255, newRed), 0))
buffer(pos + 3) = colorTo.A
End If
Next
Marshal.Copy(buffer, 0, dataTo.Scan0, buffer.Length)
destImage.UnlockBits(dataTo)
Return destImage
End Function
Image of the problem
Sub DrawGraph()
'Used to draw the current state.
G = Me.CreateGraphics
'G.Clear(Color.White) 'Sets entire background to white
G.clear(transparent)
Dim placeholder As Integer = 0 'Used to store the current point being checked.
If UsedLocations > 0 Then 'This part will only run if any points have been made
For i = 0 To 19
If Locations(i).Name <> "unused" Then 'only draws points that aren't unused.
If Locations(i).StartPoint = True Then 'only draws light blue outline if the point is selected as the start.
'the -3 on the end is to correct positions.
G.FillEllipse(Brushes.LightBlue, Locations(i).Xcoord - 3, Locations(i).Ycoord - 3, 16, 16)
End If
If Locations(i).Selected = True Then 'only draws the light green outline if the point is currently selected.
G.FillEllipse(Brushes.LightGreen, Locations(i).Xcoord - 3, Locations(i).Ycoord - 3, 16, 16)
End If
G.FillEllipse(Brushes.Black, Locations(i).Xcoord, Locations(i).Ycoord, 10, 10)
End If
Next
For i = 0 To UsedConnections - 1
'draws connections
If Connections(i).PartOfSolution = True Then
G.DrawLine(Pens.Red, Locations(Connections(i).PointOne).Xcoord + 5, Locations(Connections(i).PointOne).Ycoord + 5, Locations(Connections(i).PointTwo).Xcoord + 5, Locations(Connections(i).PointTwo).Ycoord + 5)
Else
G.DrawLine(Pens.Black, Locations(Connections(i).PointOne).Xcoord + 5, Locations(Connections(i).PointOne).Ycoord + 5, Locations(Connections(i).PointTwo).Xcoord + 5, Locations(Connections(i).PointTwo).Ycoord + 5)
End If
Next
'creating labels
Controls.Clear()
Dim NumberToMake As Integer = (39 + UsedConnections)
Dim infolabels(NumberToMake) As Label
For i = 0 To NumberToMake
infolabels(i) = New Label
infolabels(i).Height = 13
infolabels(i).BackColor = Color.Red
If i < 20 Then
infolabels(i).Text = Locations(i).Name
infolabels(i).Top = Locations(i).Ycoord - 15
infolabels(i).Left = Locations(i).Xcoord
If Locations(i).Name <> "unused" Then
Me.Controls.Add(infolabels(i))
End If
ElseIf i > 19 And i < 40 Then
'dijkstra labels
Else
Console.WriteLine(i)
Console.WriteLine(Connections(i - 40).Length)
infolabels(i).Text = CStr(Connections(i - 40).Length)
infolabels(i).Top = 0
infolabels(i).Top = (Locations(Connections(i - 40).PointOne).Ycoord + Locations(Connections(i - 40).PointTwo).Ycoord) * 0.5
'infolabels(i).Left = (Locations(Connections(i - 40).PointOne).Xcoord + Locations(Connections(i - 40).PointTwo).Xcoord) * 0.5
Me.Controls.Add(infolabels(i))
End If
infolabels(i).Width = infolabels(i).Text.Length * 15
Next
End If
End Sub
So while trying to add labels to a form to display information above points & connections, i found that they were covering them. I've already set width & height to proper conenctions, without changing anything.
I've tried setting the backcolour to red to find the problem, that did nothing.
After playing with the background colour of the form, I've found that the label has some white part added on to the sides (as pictured above), and i can't find any way to control it so that it doesn't cover up the draw objects.
Thanks in advance for help.
Edit: after investigating a little more, it seems the white space is the space the labels would normally take up before i resize them.
I had to resize the labels before adding controls to the form, like so:
If i < 20 Then
infolabels(i).Text = Locations(i).Name
infolabels(i).Top = Locations(i).Ycoord - 15
infolabels(i).Left = Locations(i).Xcoord
If Locations(i).Name <> "unused" Then
infolabels(i).Width = infolabels(i).Text.Length * 10
Me.Controls.Add(infolabels(i))
End If
ElseIf i > 19 And i < 40 Then
'dijkstra labels
Else
Console.WriteLine(i)
Console.WriteLine(Connections(i - 40).Length)
infolabels(i).Text = CStr(Connections(i - 40).Length)
'infolabels(i).Top = 0
infolabels(i).Top = (Locations(Connections(i - 40).PointOne).Ycoord + Locations(Connections(i - 40).PointTwo).Ycoord) * 0.5
infolabels(i).Left = (Locations(Connections(i - 40).PointOne).Xcoord + Locations(Connections(i - 40).PointTwo).Xcoord) * 0.5
infolabels(i).Width = infolabels(i).Text.Length * 10
Me.Controls.Add(infolabels(i))
End If
I am trying to reduce the amount of code from If... Then... Else statements and trying to use IIf(expression, true, false) for setting variables. I am having a problem where somehow the variable gets set to 0 and it's quite annoying.
For example:
'Declarations for testing (changing currenty to work for bot and top)
xval = 15
currenty = 20
largebot = 5
largecen = 5
largetop = 5
This one works:
largebot = IIf(xval > largebot, IIf(currenty >= -1 And currenty <= 21, xval, largebot), largebot)
But this one does not:
largetop = IIf(xval > largetop, IIf(Range("B2").Value = "RED or BLUE", IIf(material = 18, IIf(currenty >= 41 And currenty <= 64, xval, largetop), IIf(currenty >= 26 And currenty <= 64, xval, largetop)), IIf(currenty >= 22 And currenty <= 49, largetop = xval, largetop)), largetop)
'----------COMMENTS TO EXPLAIN DESIRED OUTCOME-------
'If the xval is greater than the highest x value (largetop),
'And if this is for RED or BLUE machines,
'And if on 18 in. material,
'And within the correct range on the material, xval. (largetop should be the value of xval)
'If on 24 in. material (not 18 in.),
'And within the correct range for 24 in. material, xval. (largetop should be the value of xval)
'If not for RED or BLUE machines (GREEN machine, then),
'If within the correct range, (both 18 in. and 24 in. are in the same range)
'largetop should be the value of xval.
'The remaining false statements keep current value.
Alright, so as I was posting this question, I figured it out. The first one worked fine and this one did not, so I was beginning to question if it was my problem, which it was. The error is that I essentially made a statement that was
largetop = largetop = xval
Shown in bold (If in code, bold doesn't show):
largetop = IIf(xval > largetop, IIf(Range("B2").Value = "RED or BLUE", IIf(material = 18, IIf(currenty >= 41 And currenty <= 64, xval, largetop), IIf(currenty >= 26 And currenty <= 64, xval, largetop)), IIf(currenty >= 22 And currenty <= 49, largetop = xval, largetop)), largetop)
Changing that to just xval fixed the problem! Hopefully someone will find this useful...
I'm looking for a way to apply a color scale to a set of cells via VBA code but not by applying some conditional formatting... I want to apply them as static colors (InteriorColor)
I've searched plenty of excel sites, google and stackoverflow and found nothing :(
For my situation if you look at the following picture:
You can see I've given it a color scale, in this example though I have done the color scale via Conditional formatting. I want to create the color scale via VBA but it must avoid using conditional formatting, I want to assign interior colors to the cells so that the colors are static which makes them visible on all mobile excel viewers, faster, won't change if I was to remove any numbers/rows.
Here are some example data Just save it in a csv and open it in excel to see the data in excel :P:
Data 1 (Yes there are blanks),Data 2,Data 3,Data 4,Data 5,Data 6
155.7321504,144.6395913,1,-4,-9.3844,0.255813953
113.0646481,120.1609771,5,-2,-2.5874,0.088082902
126.7759917,125.3691519,2,0,-0.0004,0.107843137
,0,7,,,0.035714286
123.0716084,118.0409686,4,0,0.3236,0.118881119
132.4137536,126.5740362,3,-2,-3.8814,0.090909091
70,105.9874422,6,-1,-0.3234,0.103896104
I do use the following in python but obviously I can't use this code in VBA, the following code successfully assigns hex colors to the numbers from a predefined array of 50 colors so it's pretty accurate.
def mapValues(values):
nValues = np.asarray(values, dtype="|S8")
mask = (nValues != '')
maskedValues = [float(i.split('%')[0]) for i in nValues[mask]]
colorMap = np.array(['#F8696B', '#F86E6C', '#F8736D', '#F8786E', '#F97E6F', '#F98370', '#F98871', '#FA8E72', '#FA9373', '#FA9874', '#FA9E75', '#FBA376', '#FBA877', '#FBAD78', '#FCB379', '#FCB87A', '#FCBD7B', '#FCC37C', '#FDC87D', '#FDCD7E', '#FDD37F', '#FED880', '#FEDD81', '#FEE382', '#FEE883', '#FCEB84', '#F6E984', '#F0E784', '#E9E583', '#E3E383', '#DCE182', '#D6E082', '#D0DE82', '#C9DC81', '#C3DA81', '#BDD881', '#B6D680', '#B0D580', '#AAD380', '#A3D17F', '#9DCF7F', '#96CD7E', '#90CB7E', '#8ACA7E', '#83C87D', '#7DC67D', '#77C47D', '#70C27C', '#6AC07C', '#63BE7B'])
_, bins = np.histogram(maskedValues, 49)
try:
mapped = np.digitize(maskedValues, bins)
except:
mapped = int(0)
nValues[mask] = colorMap[mapped - 1]
nValues[~mask] = "#808080"
return nValues.tolist()
Anyone have any ideas or has anyone done this before with VBA.
The following function CalcColorScale will return a color given any two colors and the scale.The scale is the value of your current data relative to the range of data. e.g. if your data is from 0 to 200 then a data value 100 would be scale 50%(.5)
The image shows the result of scaling between red and blue
Public Sub Test()
' Sets cell A1 to background purple
Sheet1.Range("A1").Interior.Color = CalcColorScale(rgbRed, rgbBlue, 0.5)
End Sub
' color1: The starting color as a long
' color2: The end color as a long
' dScale: This is the percentage in decimal of the color.
Public Function CalcColorScale(color1 As Long, color2 As Long, dScale As Double) As Long
' Convert the colors to red, green, blue components
Dim r1 As Long, g1 As Long, b1 As Long
r1 = color1 Mod 256
g1 = (color1 \ 256) Mod 256
b1 = (color1 \ 256 \ 256) Mod 256
Dim r2 As Long, g2 As Long, b2 As Long
r2 = color2 Mod 256
g2 = (color2 \ 256) Mod 256
b2 = (color2 \ 256 \ 256) Mod 256
CalcColorScale = RGB(CalcColorScaleRGB(r1, r2, dScale) _
, CalcColorScaleRGB(g1, g2, dScale) _
, CalcColorScaleRGB(b1, b2, dScale))
End Function
' Calculates the R,G or B for a color between two colors based the percentage between them
' e.g .5 would be halfway between the two colors
Public Function CalcColorScaleRGB(color1 As Long, color2 As Long, dScale As Double) As Long
If color2 < color1 Then
CalcColorScaleRGB = color1 - (Abs(color1 - color2) * dScale)
ElseIf color2 > color1 Then
CalcColorScaleRGB = color1 + (Abs(color1 - color2) * dScale)
Else
CalcColorScaleRGB = color1
End If
End Function
You could always use the python script to generate the hex colors based of csv data and then simply read the csv file holding the generated hex colors and convert rgb then set the interiorcolor to that of the rgb outcome.
Sub HexExample()
Dim i as Long
Dim LastRow as Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LastRow
Cells(i, "B").Interior.Color = HexConv(Cells(i, "A"))
Next
End Sub
Public Function HexConv(ByVal HexColor As String) As String
Dim Red As String
Green As String
Blue As String
HexColor = Replace(HexColor, "#", "")
Red = Val("&H" & Mid(HexColor, 1, 2))
Green = Val("&H" & Mid(HexColor, 3, 2))
Blue = Val("&H" & Mid(HexColor, 5, 2))
HexConv = RGB(Red, Green, Blue)
End Function
Maybe this is what you are looking for:
Sub a()
Dim vCM As Variant
vCM = Array("F8696B", "FED880", "63BE7B") ' as many as you need
' Array's lower bound is 0 unless it is set to another value using Option Base
ActiveCell.Interior.Color = Application.WorksheetFunction.Hex2Dec(CStr(vCM(2))) ' off-green in the active cell
End Sub
If you deside to forgo the Hex and use the color values then the above becomes this
Sub b()
Dim vCM As Variant
vCM = Array(16279915, 16701568, 6536827) ' as many as you need
' Array's lower bound is 0 unless it is set to another value using Option Base
ActiveCell.Interior.Color = vCM(2) ' 6536827 setts an off-green in the active cell
End Sub
In case you do not know how to get the color values, here is the manual process:
Apply an interior color to a cell. Make sure the cell is selected.
In the VBE's Immediate window, execute ?ActiveCell.Interior.Color to get the color number for the interior color you've applied in Step 1.
Good luck.
assuming:
values in A1:A40.
Sub M_snb()
[a1:A40] = [if(A1:A40="",0,A1:A40)]
sn = [index(rank(A1:A40,A1:A40),)]
For j = 1 To UBound(sn)
If Cells(j, 1) <> 0 Then Cells(j, 1).Interior.Color = RGB(Int(sn(j, 1) * 255 / 40), Abs(sn(j, 1) > UBound(sn) \ 2), 255 - Int((sn(j, 1) - 1) * (255 / 40)))
Next
[a1:A40] = [if(A1:A40=0,"",A1:A40)]
End Sub
I've managed to find the correct answer, it's actually rather simple. All you have to do is add conditional formatting and then set the .Interior.Color to the same as what the .DisplayFormat.Interior.Color is and then delete the conditional formatting.
This will do exactly what is requested in the main post; and if you want to do it as a fallback then just don't delete the conditional formatting.
' Select Range
Range("A2:A8").Select
' Set Conditional
Selection.FormatConditions.AddColorScale ColorScaleType:=3
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).ColorScaleCriteria(1).Type = xlConditionValueLowestValue
With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
.Color = 7039480
.TintAndShade = 0
End With
Selection.FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValuePercentile
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
.Color = 8711167
.TintAndShade = 0
End With
Selection.FormatConditions(1).ColorScaleCriteria(3).Type = xlConditionValueHighestValue
With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
.Color = 8109667
.TintAndShade = 0
End With
' Set Static
For i = 1 To Selection.Cells.Count
Selection.Cells(i).Interior.Color = Selection.Cells(i).DisplayFormat.Interior.Color
Next
' Delete Conditional
Selection.Cells.FormatConditions.Delete
Hopefully this helps someone in the future.
The answers above should work. Still, the color is different that from Excel...
To recreate exact the same thing as Excel color formatting, and a little more straight forward in code:
rgb(cr,cg,cb)
color1: red - rgb(248,105,107)
color2:green - rgb(99,190,123)
color3: blue - rgb(255,235,132)
code:
Sub HeatMapOnNOTSorted()
Dim val_min, val_max, val_mid As Double
Dim cr, cg, cy As Double
Dim mysht As Worksheet
Dim TargetRgn As Range
Set mysht = Sheets("Sheet1")
Set TargetRgn = mysht.Range("c4:d9") '<-Change whatever range HERE
'get the min&max value of the range
val_min = Application.WorksheetFunction.Min(TargetRgn)
val_max = Application.WorksheetFunction.Max(TargetRgn)
val_mid = 0.5 * (val_min + val_max)
For Each rgn In TargetRgn
' three color map min-mid-max
' min -> mid: green(99,190,123)-> yellow(255,235,132)
If rgn.Value <= val_mid Then
cr = 99 + (255 - 99) * (rgn.Value - val_min) / (val_mid - val_min)
cg = 190 + (235 - 190) * (rgn.Value - val_min) / (val_mid - val_min)
cb = 123 + (132 - 123) * (rgn.Value - val_min) / (val_mid - val_min)
Else
' mid->max: yellow(255,235,132) -> red(248,105,107)
cr = 255 + (248 - 255) * (rgn.Value - val_mid) / (val_max - val_mid)
cg = 235 + (105 - 235) * (rgn.Value - val_mid) / (val_max - val_mid)
cb = 132 + (107 - 132) * (rgn.Value - val_mid) / (val_max - val_mid)
End If
rgn.Interior.Color = RGB(cr, cg, cb)
Next rgn
End Sub
In Stata, I want to create a new variable with values associated with probabilities from a know distribution.
Say that the distribution pdf looks like:
Blue - .2
Red - .3
Green - .5
I can use code like the following to get the exact distribution as above. First, is there a quicker way to accomplish this?
gen Color = ""
replace Color = "Blue" if _n <= _N*.2
replace Color = "Red" if _n > _N*.2 & _n <= _N*.5
replace Color = "Green" if Color==""
To simulate random draws, I think I can do:
gen rand = runiform()
sort rand
gen Color = ""
replace Color = "Blue" if rand <= .2
replace Color = "Red" if rand > .2 & rand <= .5
replace Color = "Green" if Color==""
Is this technique best practice?
When producing the data, you could use the more efficient in instead of if. But to be honest, I believe the data set would have to be very big for time differences to be perceivable. You can do some experimenting to check for that.
The second issue on random draws is already addressed by a series of posts authored by Bill Gould (StataCorp's president). Some code below with inline comments. You can run the whole thing and check the results.
clear
set more off
*----- first question -----
/* create data with certain distribution */
set obs 100
set seed 23956
gen obs = _n
gen rand = runiform()
sort rand
gen Color = ""
/*
// original
replace Color = "Blue" if _n <= _N*.2
replace Color = "Red" if _n > _N*.2 & _n <= _N*.5
replace Color = "Green" if Color==""
*/
// using -in-
replace Color = "Blue" in 1/`=floor(_N*.2)'
replace Color = "Red" in `=floor(_N*.2) + 1'/`=floor(_N*.5)'
replace Color = "Green" in `=floor(_N*.5) + 1'/L
/*
// using -cond()-
gen Color = cond(_n <= _N*.2, "Blue", cond(_n > _N*.2 & _n <= _N*.5, "Red", "Green"))
*/
drop rand
sort obs
tempfile allobs
save "`allobs'"
tab Color
*----- second question -----
/* draw without replacement a random sample of 20
observations from a dataset of N observations */
set seed 89365
sort obs // for reproducibility
generate double u = runiform()
sort u
keep in 1/20
tab obs Color
/* If N>1,000, generate two random variables u1 and u2
in place of u, and substitute sort u1 u2 for sort u */
/* draw with replacement a random sample of 20
observations from a dataset of N observations */
clear
set seed 08236
drop _all
set obs 20
generate long obsno = floor(100*runiform()+1)
sort obsno
tempfile obstodraw
save "`obstodraw'"
use "`allobs'", clear
generate long obsno = _n
merge 1:m obsno using "`obstodraw'", keep(match) nogen
tab obs Color
These and other details can be found in the four-part series on random-number
generators, by Bill Gould: http://blog.stata.com/2012/10/24/using-statas-random-number-generators-part-4-details/
See also help sample!